Code
# Clean working environment
rm(list = ls())This supplementary file contains the R code for processing and analysing the raw data, and creating figures for the manuscript - Do females and males differ in organ scaling? A mechanistic approach and a phylogenetic multilevel analysis across vertebrates
Data subset used in this study is part of a database on organ sizes, which is available here: https://felixpleiva.github.io/organ_size_DB/. Additionally, I complemented the dataset on organ size by revisiting a recent publication by Tsuboi et al., 2018, which includes, among other information, sex- and species-specific data on organ size for numerous species of mammals, birds, and fish. Together, these approaches, allowed us to compile information for 204 vertebrate species and data on a total of 9 different organs.
# Clean working environment
rm(list = ls())This repository is provided by the authors under the Attribution-NonCommercial-NoDerivatives 4.0 International licence
When using the data and/or code associated with this repository, they must be cited as follows:
Leiva, F. P., A. J. Hendriks. (2026). Do females and males differ in organ scaling? A mechanistic approach and a phylogenetic multilevel analysis across vertebrates. Zenodo. pending DOI.
This script is authored by Félix P. Leiva. For any questions related to this resource, please contact me at the email address: felixpleiva@gmail.com.
dat <- read_xlsx("../outputs/dat_for_analyses_full_merged.xlsx") %>%
rename(
sex = sex_individual,
life_stage = life_stage_individual,
original_category = trait_size_category,
body_size = body_size_mean,
organ_size = organ_size_mean,
species = species_reported
) %>%
mutate(organ_grouped = recode(organ_grouped,
pituitary_gland = "pituitary_glands",
lung = "lungs",
kidney = "kidneys")) %>%
mutate(class = recode(class,
Actinopterygii = "Teleostei"))
# Calculate mean per species and sex. Most species were represented primarily by adults. Life stages that were not explicitly reported were assumed to correspond to adult individuals.
dat_mean <- dat %>%
group_by(
phylum, class, order, family, genus,
species, sex, organ_grouped
) %>%
summarise(
body_size = mean(body_size, na.rm = TRUE),
organ_size = mean(organ_size, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
log10_body_size = log10(body_size),
log10_organ_size = log10(organ_size),
phylo = gsub(" ", "_", species)
)Next, from the preceding code, I will extract the list of species for which I want to retrieve the phylogenetic tree and export it to my working directory.
list_of_species <- dat_mean %>%
distinct(species) %>%
pull(species) %>%
as.character()
writeLines(list_of_species, "../outputs/list_of_species.txt")Now I have exported the list of species, I will visit the TimeTree of Life website and, in the lower section labelled Load a list of species, upload the file list_of_species.csv. Subsequently, I will export it in Newick format. Note that not all species from our list are included in the resulting tree, although most are represented.
glimpse(dat_mean)Rows: 676
Columns: 13
$ phylum <chr> "Chordata", "Chordata", "Chordata", "Chordata", "Chor…
$ class <chr> "Aves", "Aves", "Aves", "Aves", "Aves", "Aves", "Aves…
$ order <chr> "Anseriformes", "Anseriformes", "Anseriformes", "Anse…
$ family <chr> "Anatidae", "Anatidae", "Anatidae", "Anatidae", "Anat…
$ genus <chr> "Anas", "Anas", "Anas", "Anas", "Anas", "Anas", "Anas…
$ species <chr> "Anas acuta", "Anas acuta", "Anas crecca", "Anas crec…
$ sex <chr> "female", "male", "female", "male", "female", "female…
$ organ_grouped <chr> "brain", "brain", "brain", "brain", "adrenal_glands",…
$ body_size <dbl> 721, 1176, 279, 347, 2921, 1200, 2921, 2921, 2921, 29…
$ organ_size <dbl> 4.91, 5.28, 3.18, 2.90, 0.13, 5.44, 19.50, 17.40, 3.5…
$ log10_body_size <dbl> 2.9, 3.1, 2.4, 2.5, 3.5, 3.1, 3.5, 3.5, 3.5, 3.5, 3.5…
$ log10_organ_size <dbl> 0.691, 0.723, 0.503, 0.463, -0.886, 0.736, 1.290, 1.2…
$ phylo <chr> "Anas_acuta", "Anas_acuta", "Anas_crecca", "Anas_crec…
columns_to_factor <- c(
"phylum",
"class",
"order",
"family",
"genus",
"species",
"phylo",
"sex",
"organ_grouped"
)columns_to_numeric <- c(
"body_size",
"organ_size",
"log10_organ_size",
"log10_body_size"
)# Apply the conversions to the dataset.
dat_mean <- dat_mean %>%
mutate(
across(all_of(columns_to_factor), as.factor),
across(all_of(columns_to_numeric), as.numeric)
)
# Confirm that changes have been applied correctly
glimpse(dat_mean)Rows: 676
Columns: 13
$ phylum <fct> Chordata, Chordata, Chordata, Chordata, Chordata, Cho…
$ class <fct> Aves, Aves, Aves, Aves, Aves, Aves, Aves, Aves, Aves,…
$ order <fct> Anseriformes, Anseriformes, Anseriformes, Anseriforme…
$ family <fct> Anatidae, Anatidae, Anatidae, Anatidae, Anatidae, Ana…
$ genus <fct> Anas, Anas, Anas, Anas, Anas, Anas, Anas, Anas, Anas,…
$ species <fct> Anas acuta, Anas acuta, Anas crecca, Anas crecca, Ana…
$ sex <fct> female, male, female, male, female, female, female, f…
$ organ_grouped <fct> brain, brain, brain, brain, adrenal_glands, brain, he…
$ body_size <dbl> 721, 1176, 279, 347, 2921, 1200, 2921, 2921, 2921, 29…
$ organ_size <dbl> 4.91, 5.28, 3.18, 2.90, 0.13, 5.44, 19.50, 17.40, 3.5…
$ log10_body_size <dbl> 2.9, 3.1, 2.4, 2.5, 3.5, 3.1, 3.5, 3.5, 3.5, 3.5, 3.5…
$ log10_organ_size <dbl> 0.691, 0.723, 0.503, 0.463, -0.886, 0.736, 1.290, 1.2…
$ phylo <fct> Anas_acuta, Anas_acuta, Anas_crecca, Anas_crecca, Ana…
Filter the dataframe to include only organs with at least five species per sex and organ. Some of them have only three species per sex. From this output, the thymus, large intestine, and small intestine are excluded.
# First identify qualifying organ-sex combinations
organs_five_species <- dat_mean %>%
count(organ_grouped, species, sex) %>%
group_by(organ_grouped, sex) %>% # by sex and organ
summarise(n_species = n_distinct(species), .groups = "drop") %>%
filter(n_species >= 5) # at least 5 spp
# Then filter original data to these combinations only
dat_mean <- dat_mean %>%
inner_join(organs_five_species %>% select(organ_grouped, sex),
by = c("organ_grouped", "sex"))
# Lets check whcih organs were retained after this filter
dat_mean %>%
summarise(n_species = n_distinct(species), .by = organ_grouped)# A tibble: 10 × 2
organ_grouped n_species
<fct> <int>
1 brain 246
2 adrenal_glands 7
3 heart 12
4 kidneys 8
5 liver 14
6 pancreas 6
7 spleen 11
8 stomach 8
9 pituitary_glands 7
10 lungs 8
In addition to the five-species filter, we applied a ten-species filter when the organ in question was the brain. This was done to make our analyses more comparable to those recently published by Tsuboi et al. (2018). Moreover, this approach allowed us to assess the robustness and granularity of our results within a subset of species for which more data were available. The ten-species filter encompassed a total of two families of fish, five families of birds, and three families of mammals.
# Identify qualifying families (>10 unique species per family) for brain only
good_families_brain <- dat_mean %>%
filter(organ_grouped == "brain") %>%
group_by(family) %>%
summarise(n_species = n_distinct(species), .groups = "drop") %>%
filter(n_species > 10) %>%
pull(family)
# Filter main dataset: keep ALL non-brain data + brain data for qualifying families only
dat_mean<- dat_mean %>%
filter(organ_grouped != "brain" | family %in% good_families_brain) %>%
droplevels() # here i drop the rows filtered out
# Species counts per organ, class, order, family
species_summary <- dat_mean %>%
distinct(organ_grouped, class, order, family, species, .keep_all = TRUE) %>%
count(organ_grouped, class, order, family, name = "n_species_unique") %>%
arrange(organ_grouped, class, desc(n_species_unique))One of the things I discovered recently is the library (DT), which enables the creation of these interactive tables that allow for much more dynamic filtering. Super cool!
datatable(
species_summary,
filter = "top",
options = list(
pageLength = 15,
autoWidth = TRUE,
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel')
),
colnames = c("Organ", "Class", "Order", "Family", "Species count")
)tree <- read.tree("../outputs/phylogenetic_tree.nwk")
# Number of tips (species)
length(tree$tip.label)[1] 277
Our next step is to prune the tree to retain only those species for which organ size measurements exist for both males and females. This pruning is important because our phylogenetic informed analyses require the calculation of a variance-covariance matrix based on the shared evolutionary history of the species.
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_mean$phylo) # Tree species absent in database [1] "Pseudosimochromis_babaulti"
[2] "Oostethus_brachyurus"
[3] "Dunckerocampus_dactyliophorus"
[4] "Madoqua_kirkii"
[5] "Philantomba_monticola"
[6] "Aotus_trivirgatus"
[7] "Cebuella_pygmaea"
[8] "Callithrix_penicillata"
[9] "Callimico_goeldii"
[10] "Leontopithecus_chrysomelas"
[11] "Leontopithecus_rosalia"
[12] "Leontocebus_fuscicollis_illigeri"
[13] "Saguinus_mystax"
[14] "Saguinus_labiatus_labiatus"
[15] "Saguinus_leucopus"
[16] "Saguinus_midas"
[17] "Saguinus_niger"
[18] "Saguinus_oedipus"
[19] "Saguinus_geoffroyi"
[20] "Cebus_olivaceus"
[21] "Cebus_capucinus"
[22] "Sapajus_xanthosternos"
[23] "Cebus_nigritus_robustus"
[24] "Saimiri_sciureus_macrodon"
[25] "Saimiri_sciureus_sciureus"
[26] "Saimiri_sciureus_cassiquiarensis"
[27] "Chlorocebus_pygerythrus_pygerythrus"
[28] "Cercopithecus_mitis_stuhlmanni"
[29] "Cercopithecus_albogularis_kolbi"
[30] "Cercopithecus_albogularis_erythrarchus"
[31] "Cercopithecus_mona"
[32] "Cercopithecus_neglectus"
[33] "Papio_hamadryas"
[34] "Theropithecus_gelada"
[35] "Macaca_radiata_radiata"
[36] "Macaca_nemestrina"
[37] "Macaca_leonina"
[38] "Semnopithecus_entellus"
[39] "Semnopithecus_priam"
[40] "Trachypithecus_vetulus_vetulus"
[41] "Trachypithecus_phayrei_shanicus"
[42] "Trachypithecus_phayrei_crepuscula"
[43] "Presbytis_thomasi"
[44] "Presbytis_rubicunda_rubicunda"
[45] "Presbytis_melalophos_sumatranus"
[46] "Presbytis_femoralis_percura"
[47] "Nasalis_larvatus"
[48] "Procolobus_verus"
[49] "Piliocolobus_tephrosceles"
[50] "Piliocolobus_kirkii"
[51] "Colobus_vellerosus"
[52] "Colobus_polykomos"
[53] "Colobus_angolensis_palliatus"
[54] "Psephotellus_varius"
[55] "Orthopsittaca_manilatus"
[56] "Lophochroa_leadbeateri"
[57] "Zanda_funerea"
[58] "Crithagra_dorsostriata"
[59] "Crithagra_burtoni"
[60] "Bathilda_ruficauda"
[61] "Granatina_ianthinogaster"
[62] "Chloebia_gouldiae"
[63] "Spinus_spinus"
[64] "Linaria_cannabina"
[65] "Crithagra_mozambica"
[66] "Spinus_cucullatus"
[67] "Acanthis_flammea"
[68] "Chloris_spinoides"
[69] "Chloris_ambigua"
[70] "Chloris_chloris"
[71] "Aythya_fuligula"
[72] "Tetrastes_bonasia"
[73] "Gallus_lafayettii"
setdiff(dat_mean$phylo, tree$tip.label) # Database species absent in tree [1] "Nyroca_fuligula" "Ammoperdix_griseogularis"
[3] "Bonasa_bonasia" "Gallus_lafayetii"
[5] "Lagopus_mutus" "Erythrura_gouldiae"
[7] "Lonchura_grandis" "Lonchura_molucca"
[9] "Lonchura_pallida" "Lonchura_quinticolor"
[11] "Lonchura_spectabilis" "Lonchura_tristissima"
[13] "Mandingoa_nitidula" "Neochmia_ruficauda"
[15] "Pyrenestes_ostrinus" "Uraeginthus_ianthinogaster"
[17] "Carduelis_ambigua" "Carduelis_cannabina"
[19] "Carduelis_chloris" "Carduelis_cucullata"
[21] "Carduelis_flammea" "Carduelis_spinoides"
[23] "Carduelis_spinus" "Serinus_burtoni"
[25] "Serinus_dorsostriatus" "Serinus_mozambicus"
[27] "Cacatua_leadbeateri" "Calyptorhynchus_funereus"
[29] "Orthopsittaca_manilata" "Polytelis_swainsonii"
[31] "Psephotus_varius" "Cephalophus_monticola"
[33] "Eudorcas_thomsoni" "Madoqua_kirki"
[35] "Saimiri_sciureus" "Chlorocebus_aethiops_sabaeus"
[37] "Simochromis_babaulti" "Doryichthys_martensi"
[39] "Doryrhamphus_dactyliophorus" "Microphis_brachyurus"
[41] "Trachyhampus_serratus"
# Exclude mismatched species for consistency
tree <- keep.tip(tree, intersect(tree$tip.label, dat_mean$phylo))
dat_mean <- dat_mean[dat_mean$phylo %in% tree$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree$tip.label, dat_mean$phylo)character(0)
setdiff(dat_mean$phylo, tree$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree)[1] TRUE
# how many species?
length(tree$tip.label)[1] 204
# Compute phylogenetic covariance matrix (Brownian motion)
A <- vcv.phylo(tree, corr = TRUE)How many species have phylogenetic information available across all taxonomic classes for the brain?
dat_mean %>%
count(organ_grouped, species, class) %>%
group_by(organ_grouped) %>%
filter(organ_grouped == "brain") %>%
summarise(
n_species = n_distinct(species),
.groups = 'drop'
) %>%
arrange(desc(n_species))# A tibble: 1 × 2
organ_grouped n_species
<fct> <int>
1 brain 189
dat_mean %>%
count(organ_grouped, species) %>%
group_by(organ_grouped) %>%
count(organ_grouped, name = "n_species") %>%
arrange(desc(n_species))# A tibble: 10 × 2
# Groups: organ_grouped [10]
organ_grouped n_species
<fct> <int>
1 brain 189
2 liver 12
3 heart 10
4 spleen 9
5 stomach 8
6 kidneys 6
7 lungs 6
8 adrenal_glands 5
9 pituitary_glands 5
10 pancreas 4
Since our objective is to account for the evolutionary history of the species, it is essential to recognise that, in a comparative context, species cannot be treated as independent units of observation. Closely related species tend to exhibit similar values for a given trait due to shared ancestry. Although no strict rule exists for the minimum number of species required, Garland and Adolph’s paper Why Not to Do Two-Species Comparative Studies: Limitations on Inferring Adaptation’ discusses relevant limitations and recommends broader sampling. As a rule of thumb, we evaluated the effects of accounting for shared evolutionary history in organs measured across more than 5 species, and compared these results with non-phylogenetic models (onward refereed as simple models). It means we won´t include pancreas size in the analysis.
Exclude pancreas from the analysis (only four species)
dat_mean <- dat_mean %>%
filter(organ_grouped != "pancreas")
# Confirm pancreas is gone
unique(dat_mean$organ_grouped)[1] brain adrenal_glands heart kidneys
[5] liver spleen stomach pituitary_glands
[9] lungs
10 Levels: adrenal_glands brain heart kidneys liver lungs ... stomach
And now re-run the previous lines para merge the tree and data, el cual debeiera exlcuir los datos de pancreas
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_mean$phylo) # Tree species absent in databasecharacter(0)
setdiff(dat_mean$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree <- keep.tip(tree, intersect(tree$tip.label, dat_mean$phylo))
dat_mean <- dat_mean[dat_mean$phylo %in% tree$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree$tip.label, dat_mean$phylo)character(0)
setdiff(dat_mean$phylo, tree$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree)[1] TRUE
# how many species?
length(tree$tip.label)[1] 204
# Compute phylogenetic covariance matrix (Brownian motion)
A <- vcv.phylo(tree, corr = TRUE)Lets count species again by organ
dat_mean %>%
count(organ_grouped, species) %>%
group_by(organ_grouped) %>%
count(organ_grouped, name = "n_species") %>%
arrange(desc(n_species))# A tibble: 9 × 2
# Groups: organ_grouped [9]
organ_grouped n_species
<fct> <int>
1 brain 189
2 liver 12
3 heart 10
4 spleen 9
5 stomach 8
6 kidneys 6
7 lungs 6
8 adrenal_glands 5
9 pituitary_glands 5
and taxonomic Class
dat_mean %>%
count(class, species) %>%
group_by(class) %>%
count(class, name = "n_species") %>%
arrange(desc(n_species))# A tibble: 4 × 2
# Groups: class [4]
class n_species
<fct> <int>
1 Aves 98
2 Teleostei 70
3 Mammalia 35
4 Reptilia 1
Now the tree match the species in the dataframe, we will create a figure of the phylogenetic tree containing the 204 species for which we have organ size data for both males and females. We will add a plot indicating whether each organ was measured (green) or not (grey).
Our analyses for most organs are based on a relatively small number of observations (i.e., species). This may limit the interpretability of our models, particularly when they are compared to one another. Model comparison using cross-validation (via the loo_compare function) was implemented in some cases following the recommendations in the cross-validation FAQ, particularly regarding influential observations. In the preceding link Aki Vehtari states: Pareto-k is also useful as a measure of influence of an observation. Highly influential observations have high k^ values. Very high k values often indicate model misspecification, outliers or mistakes in data processing. For this reason, we decided to include additional species by searching for complementary datasets. We ultimately incorporated the dataset from Tsuboi et al., which, to our knowledge, represents the most extensive available compilation of vertebrate organ (particularly brain) size data for males and females.
# Prepara data to merge with tree
dat_mean$organ_grouped <- gsub("_", " ", dat_mean$organ_grouped)
summary_data <- dat_mean %>%
count(phylo, organ_grouped) %>%
mutate(presence = if_else(n > 0, "Yes", "No")) %>%
select(-n) %>%
pivot_wider(
names_from = organ_grouped,
values_from = presence,
values_fill = list(presence = "No")
)
summary_data <- summary_data[summary_data$phylo %in% tree$tip.label, ]
datF_organs <- summary_data %>%
column_to_rownames("phylo") %>%
as.matrix()
# force matc between data and tree
datF_organs <- datF_organs[tree$tip.label, , drop = FALSE]
# Create phylogeny tree
circ <- ggtree(tree, layout = "fan", open.angle = 18)
circ <- rotate_tree(circ, 90)
Figure_1 <- gheatmap(
circ,
datF_organs,
width = 0.4,
offset = 0,
colnames_offset_x = 0,
colnames_offset_y = 0,
font.size = 2,
hjust = 0
) +
scale_fill_manual(values = c("grey90", "#009E73"), name = "Organ measured") +
theme(
legend.position = c(0.57, 0.55),
legend.background = element_rect(fill = "transparent", colour = NA),
legend.box.background = element_rect(fill = "transparent", colour = NA),
legend.title = element_text(size = 8),
legend.text = element_text(size = 6),
legend.key.size = unit(0.8, "cm"),
legend.key.height = unit(0.4, "cm"),
legend.key.width = unit(0.4, "cm")
)
Figure_1# Export figure
ggsave('../outputs/Figure_1.pdf', Figure_1, width = 7, height = 7)# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "liver")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Poecilia_reticulata" "Nerophis_lumbriciformis"
[55] "Syngnathus_abaster" "Syngnathus_schlegeli"
[57] "Hippocampus_comes" "Hippocampus_trimaculatus"
[59] "Hippocampus_kuda" "Hippocampus_spinosissimus"
[61] "Hippocampus_abdominalis" "Hippichthys_cyanospilos"
[63] "Syngnathoides_biaculeatus" "Corythoichthys_intestinalis"
[65] "Corythoichthys_haematopterus" "Doryichthys_boaja"
[67] "Doryrhamphus_japonicus" "Entelurus_aequoreus"
[69] "Syncerus_caffer" "Tragelaphus_eurycerus"
[71] "Tragelaphus_scriptus" "Redunca_arundinum"
[73] "Antidorcas_marsupialis" "Nanger_granti"
[75] "Raphicerus_campestris" "Cephalophus_natalensis"
[77] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[79] "Hippotragus_equinus" "Addax_nasomaculatus"
[81] "Oryx_gazella" "Connochaetes_taurinus"
[83] "Damaliscus_lunatus" "Ovis_aries"
[85] "Aepyceros_melampus" "Pteropus_alecto"
[87] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[89] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[91] "Erythrocebus_patas" "Papio_cynocephalus"
[93] "Papio_anubis" "Cercocebus_atys"
[95] "Macaca_arctoides" "Macaca_mulatta"
[97] "Macaca_maura" "Trachypithecus_francoisi"
[99] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[101] "Platycercus_elegans" "Platycercus_eximius"
[103] "Platycercus_venustus" "Barnardius_zonarius"
[105] "Northiella_haematogaster" "Lathamus_discolor"
[107] "Neophema_chrysostoma" "Neophema_pulchella"
[109] "Psittacula_krameri" "Eclectus_roratus"
[111] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[113] "Alisterus_amboinensis" "Polytelis_alexandrae"
[115] "Trichoglossus_haematodus" "Agapornis_lilianae"
[117] "Agapornis_taranta" "Loriculus_vernalis"
[119] "Ara_ararauna" "Guaruba_guarouba"
[121] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[123] "Forpus_coelestis" "Forpus_passerinus"
[125] "Amazona_leucocephala" "Amazona_albifrons"
[127] "Amazona_pretrei" "Amazona_vinacea"
[129] "Amazona_finschi" "Amazona_amazonica"
[131] "Amazona_ochrocephala" "Amazona_aestiva"
[133] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[135] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[137] "Poicephalus_meyeri" "Psittacus_erithacus"
[139] "Serinus_mennelli" "Padda_oryzivora"
[141] "Lonchura_punctulata" "Lonchura_flaviprymna"
[143] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[145] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[147] "Amandava_amandava" "Plectrophenax_nivalis"
[149] "Serinus_canaria" "Serinus_serinus"
[151] "Loxia_curvirostra" "Carduelis_carduelis"
[153] "Carpodacus_roseus" "Uragus_sibiricus"
[155] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[157] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[159] "Mycerobas_affinis" "Mycerobas_carnipes"
[161] "Fringilla_montifringilla" "Fringilla_coelebs"
[163] "Anas_acuta" "Anas_crecca"
[165] "Mergus_serrator" "Mergus_merganser"
[167] "Bucephala_clangula" "Melanitta_nigra"
[169] "Somateria_mollissima" "Callonetta_leucophrys"
[171] "Branta_bernicla" "Branta_leucopsis"
[173] "Anser_anser" "Cygnus_columbianus"
[175] "Tadorna_tadorna" "Pucrasia_macrolopha"
[177] "Phasianus_colchicus" "Chrysolophus_pictus"
[179] "Lophura_nycthemera" "Lophura_ignita"
[181] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[183] "Perdix_perdix" "Tetrao_urogallus"
[185] "Lagopus_muta" "Lagopus_lagopus"
[187] "Lophophorus_impejanus" "Tragopan_temminckii"
[189] "Pavo_cristatus" "Gallus_sonneratii"
[191] "Rollulus_rouloul" "Arborophila_torqueola"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 12
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_liver <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 2.8 seconds.
Chain 4 finished in 3.5 seconds.
Chain 3 finished in 3.7 seconds.
Chain 1 finished in 4.4 seconds.
All 4 chains finished successfully.
Mean chain execution time: 3.6 seconds.
Total execution time: 4.5 seconds.
pp_check(model_simple_liver)summary(model_simple_liver) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 24)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.30 0.31 0.01 1.12 1.00
sd(log10_body_size) 0.18 0.22 0.00 0.81 1.00
cor(Intercept,log10_body_size) -0.08 0.59 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2690 2972
sd(log10_body_size) 1903 3263
cor(Intercept,log10_body_size) 4124 4348
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.34 0.31 -1.98 -0.75 1.00 2946 2317
log10_body_size 0.85 0.15 0.48 1.14 1.00 1706 1586
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.18 0.03 0.13 0.26 1.00 5259 4010
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_liver)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_liver)$sex)[[1]],
slope = coef(model_simple_liver)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_liver)$sex)[[1]],
slope_low = coef(model_simple_liver)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_liver)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.29 -1.56 -1.01 0.868 0.756 0.976
2 male -1.36 -1.63 -1.10 0.876 0.772 0.986
model_phylo_liver <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 3 finished in 12.6 seconds.
Chain 2 finished in 12.7 seconds.
Chain 1 finished in 12.9 seconds.
Chain 4 finished in 16.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 13.5 seconds.
Total execution time: 16.1 seconds.
pp_check(model_phylo_liver)summary(model_phylo_liver) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 24)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 12)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.18 0.06 0.10 0.32 1.00 2911 4442
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.25 0.28 0.01 1.00 1.00
sd(log10_body_size) 0.15 0.19 0.00 0.68 1.00
cor(Intercept,log10_body_size) -0.04 0.61 -0.97 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3265 3752
sd(log10_body_size) 2489 4785
cor(Intercept,log10_body_size) 5417 5026
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.48 0.27 -2.06 -0.97 1.00 3578 4630
log10_body_size 0.88 0.12 0.58 1.12 1.00 2828 2704
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.07 0.01 0.04 0.10 1.00 3796 4733
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_liver, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.48 0.3 0.02 0.94 0.2
Post.Prob Star
1 0.17 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_liver <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_liver)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_liver)$sex)[[1]],
slope = coef(model_phylo_liver)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_liver)$sex)[[1]],
slope_low = coef(model_phylo_liver)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_liver)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.45 -1.73 -1.18 0.897 0.827 0.971
2 male -1.50 -1.77 -1.24 0.894 0.825 0.968
loo_simple <- loo(model_simple_liver)
loo_phylo <- loo(model_phylo_liver)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_liver 0.0 0.0
model_simple_liver -19.6 3.8
In this comparison, the model that accounts for phylogeny performs better to the model that treats species as independent observational units. The phylogenetic model (model_phylo_liver) is used as the reference with elpd_diff = 0, whereas the simpler model (model_simple_liver) has an expected log predictive density (ELPD) that is about 19.6 units lower, with an associated standard error of 3.8. In the context of leave‑one‑out cross‑validation, differences exceeding roughly four to five times their standard error are typically regarded as strong evidence (Vehtari et al., 2016; Sivula et al., 2025). Here, 19.6/3.8≈5.2, which provides strong evidence in favour of the phylogenetic model.
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "heart")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Nerophis_lumbriciformis"
[55] "Syngnathus_abaster" "Syngnathus_schlegeli"
[57] "Hippocampus_comes" "Hippocampus_trimaculatus"
[59] "Hippocampus_kuda" "Hippocampus_spinosissimus"
[61] "Hippocampus_abdominalis" "Hippichthys_cyanospilos"
[63] "Syngnathoides_biaculeatus" "Corythoichthys_intestinalis"
[65] "Corythoichthys_haematopterus" "Doryichthys_boaja"
[67] "Doryrhamphus_japonicus" "Entelurus_aequoreus"
[69] "Anguilla_anguilla" "Syncerus_caffer"
[71] "Tragelaphus_eurycerus" "Tragelaphus_scriptus"
[73] "Redunca_arundinum" "Antidorcas_marsupialis"
[75] "Nanger_granti" "Raphicerus_campestris"
[77] "Cephalophus_natalensis" "Sylvicapra_grimmia"
[79] "Oreotragus_oreotragus" "Hippotragus_equinus"
[81] "Addax_nasomaculatus" "Oryx_gazella"
[83] "Connochaetes_taurinus" "Damaliscus_lunatus"
[85] "Ovis_aries" "Aepyceros_melampus"
[87] "Pteropus_alecto" "Pteropus_poliocephalus"
[89] "Pteropus_scapulatus" "Chlorocebus_aethiops"
[91] "Chlorocebus_sabaeus" "Erythrocebus_patas"
[93] "Papio_cynocephalus" "Papio_anubis"
[95] "Cercocebus_atys" "Macaca_arctoides"
[97] "Macaca_mulatta" "Macaca_maura"
[99] "Trachypithecus_francoisi" "Platycercus_caledonicus"
[101] "Platycercus_elegans" "Platycercus_eximius"
[103] "Platycercus_venustus" "Barnardius_zonarius"
[105] "Northiella_haematogaster" "Lathamus_discolor"
[107] "Neophema_chrysostoma" "Neophema_pulchella"
[109] "Psittacula_krameri" "Eclectus_roratus"
[111] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[113] "Alisterus_amboinensis" "Polytelis_alexandrae"
[115] "Trichoglossus_haematodus" "Agapornis_lilianae"
[117] "Agapornis_taranta" "Loriculus_vernalis"
[119] "Ara_ararauna" "Guaruba_guarouba"
[121] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[123] "Forpus_coelestis" "Forpus_passerinus"
[125] "Amazona_leucocephala" "Amazona_albifrons"
[127] "Amazona_pretrei" "Amazona_vinacea"
[129] "Amazona_finschi" "Amazona_amazonica"
[131] "Amazona_ochrocephala" "Amazona_aestiva"
[133] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[135] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[137] "Poicephalus_meyeri" "Psittacus_erithacus"
[139] "Serinus_mennelli" "Ficedula_hypoleuca"
[141] "Padda_oryzivora" "Lonchura_punctulata"
[143] "Lonchura_flaviprymna" "Lonchura_bicolor"
[145] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[147] "Uraeginthus_bengalus" "Amandava_amandava"
[149] "Plectrophenax_nivalis" "Serinus_canaria"
[151] "Serinus_serinus" "Loxia_curvirostra"
[153] "Carduelis_carduelis" "Carpodacus_roseus"
[155] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[157] "Pinicola_enucleator" "Bucanetes_githagineus"
[159] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[161] "Mycerobas_carnipes" "Fringilla_montifringilla"
[163] "Fringilla_coelebs" "Anas_acuta"
[165] "Anas_crecca" "Mergus_serrator"
[167] "Mergus_merganser" "Bucephala_clangula"
[169] "Melanitta_nigra" "Somateria_mollissima"
[171] "Callonetta_leucophrys" "Branta_bernicla"
[173] "Branta_leucopsis" "Anser_anser"
[175] "Cygnus_columbianus" "Tadorna_tadorna"
[177] "Pucrasia_macrolopha" "Phasianus_colchicus"
[179] "Chrysolophus_pictus" "Lophura_nycthemera"
[181] "Lophura_ignita" "Syrmaticus_ellioti"
[183] "Syrmaticus_reevesii" "Perdix_perdix"
[185] "Tetrao_urogallus" "Lagopus_muta"
[187] "Lagopus_lagopus" "Lophophorus_impejanus"
[189] "Tragopan_temminckii" "Pavo_cristatus"
[191] "Gallus_gallus" "Gallus_sonneratii"
[193] "Rollulus_rouloul" "Arborophila_torqueola"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 10
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_heart <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 2.1 seconds.
Chain 4 finished in 2.6 seconds.
Chain 1 finished in 3.2 seconds.
Chain 3 finished in 3.1 seconds.
All 4 chains finished successfully.
Mean chain execution time: 2.8 seconds.
Total execution time: 3.3 seconds.
pp_check(model_simple_heart)summary(model_simple_heart) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 20)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.27 0.30 0.01 1.04 1.00
sd(log10_body_size) 0.19 0.22 0.00 0.80 1.00
cor(Intercept,log10_body_size) -0.07 0.61 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3635 3605
sd(log10_body_size) 2149 3479
cor(Intercept,log10_body_size) 4205 4565
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.92 0.29 -3.49 -2.35 1.00 3737 3845
log10_body_size 1.20 0.16 0.79 1.49 1.00 2413 2315
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.25 0.05 0.18 0.36 1.00 5488 3595
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_heart)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_heart)$sex)[[1]],
slope = coef(model_simple_heart)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_heart)$sex)[[1]],
slope_low = coef(model_simple_heart)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_heart)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.94 -3.21 -2.67 1.24 1.13 1.35
2 male -2.91 -3.16 -2.65 1.23 1.13 1.34
model_phylo_heart <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 13.3 seconds.
Chain 3 finished in 14.4 seconds.
Chain 1 finished in 14.5 seconds.
Chain 2 finished in 15.3 seconds.
All 4 chains finished successfully.
Mean chain execution time: 14.4 seconds.
Total execution time: 15.4 seconds.
pp_check(model_phylo_heart)summary(model_phylo_heart) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 20)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 10)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.53 0.15 0.31 0.90 1.00 1983 2846
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.19 0.25 0.00 0.90 1.00
sd(log10_body_size) 0.14 0.19 0.00 0.68 1.00
cor(Intercept,log10_body_size) -0.05 0.62 -0.98 0.97 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2944 3477
sd(log10_body_size) 1979 2037
cor(Intercept,log10_body_size) 4467 2200
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.63 0.39 -3.38 -1.83 1.00 2352 3851
log10_body_size 0.95 0.14 0.65 1.24 1.00 1652 1970
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.05 0.02 0.03 0.10 1.00 1526 1969
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_heart, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.84 0.21 0.22 1 0
Post.Prob Star
1 0 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_heart <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_heart)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_heart)$sex)[[1]],
slope = coef(model_phylo_heart)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_heart)$sex)[[1]],
slope_low = coef(model_phylo_heart)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_heart)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.64 -3.27 -1.95 0.951 0.767 1.12
2 male -2.63 -3.26 -1.94 0.957 0.786 1.12
loo_simple <- loo(model_simple_heart, moment_match = TRUE)Running /Library/Frameworks/R.framework/Resources/bin/R CMD SHLIB foo.c
using C compiler: ‘Apple clang version 17.0.0 (clang-1700.6.3.2)’
using SDK: ‘MacOSX26.2.sdk’
clang -arch arm64 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/Rcpp/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/unsupported" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/BH/include" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/src/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppParallel/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/rstan/include" -DEIGEN_NO_DEBUG -DBOOST_DISABLE_ASSERTS -DBOOST_PENDING_INTEGER_LOG2_HPP -DSTAN_THREADS -DUSE_STANC3 -DSTRICT_R_HEADERS -DBOOST_PHOENIX_NO_VARIADIC_EXPRESSION -D_HAS_AUTO_PTR_ETC=0 -include '/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/stan/math/prim/fun/Eigen.hpp' -D_REENTRANT -DRCPP_PARALLEL_USE_TBB=1 -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c foo.c -o foo.o
In file included from <built-in>:1:
In file included from /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/stan/math/prim/fun/Eigen.hpp:22:
In file included from /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/Eigen/Dense:1:
In file included from /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/Eigen/Core:19:
/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/Eigen/src/Core/util/Macros.h:679:10: fatal error: 'cmath' file not found
679 | #include <cmath>
| ^~~~~~~
1 error generated.
make: *** [foo.o] Error 1
loo_phylo <- loo(model_phylo_heart, moment_match = TRUE)Running /Library/Frameworks/R.framework/Resources/bin/R CMD SHLIB foo.c
using C compiler: ‘Apple clang version 17.0.0 (clang-1700.6.3.2)’
using SDK: ‘MacOSX26.2.sdk’
clang -arch arm64 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/Rcpp/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/unsupported" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/BH/include" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/src/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppParallel/include/" -I"/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/rstan/include" -DEIGEN_NO_DEBUG -DBOOST_DISABLE_ASSERTS -DBOOST_PENDING_INTEGER_LOG2_HPP -DSTAN_THREADS -DUSE_STANC3 -DSTRICT_R_HEADERS -DBOOST_PHOENIX_NO_VARIADIC_EXPRESSION -D_HAS_AUTO_PTR_ETC=0 -include '/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/stan/math/prim/fun/Eigen.hpp' -D_REENTRANT -DRCPP_PARALLEL_USE_TBB=1 -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c foo.c -o foo.o
In file included from <built-in>:1:
In file included from /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/StanHeaders/include/stan/math/prim/fun/Eigen.hpp:22:
In file included from /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/Eigen/Dense:1:
In file included from /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/Eigen/Core:19:
/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/RcppEigen/include/Eigen/src/Core/util/Macros.h:679:10: fatal error: 'cmath' file not found
679 | #include <cmath>
| ^~~~~~~
1 error generated.
make: *** [foo.o] Error 1
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_heart 0.0 0.0
model_simple_heart -25.1 3.5
In this comparison, the model that accounts for phylogeny is clearly preferable to the model that treats species as independent observational units. The phylogenetic model (model_phylo_heart) is used as the reference with elpd_diff = 0, whereas the simpler model (model_simple_heart) has an expected log predictive density (ELPD) that is about 25.1 units lower, with an associated standard error of 3.5. In the context of leave‑one‑out cross‑validation, differences exceeding roughly four times their standard error are typically regarded as strong evidence. Here, 25.1/3.5≈7.2, indicating a very large difference relative to its uncertainty, and thus providing strong support for the phylogenetic model.
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "pituitary glands")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Lasiopodomys_brandtii"
[89] "Mus_musculus" "Meriones_unguiculatus"
[91] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[93] "Erythrocebus_patas" "Papio_cynocephalus"
[95] "Papio_anubis" "Cercocebus_atys"
[97] "Macaca_arctoides" "Macaca_mulatta"
[99] "Macaca_maura" "Trachypithecus_francoisi"
[101] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[103] "Platycercus_elegans" "Platycercus_eximius"
[105] "Platycercus_venustus" "Barnardius_zonarius"
[107] "Northiella_haematogaster" "Lathamus_discolor"
[109] "Neophema_chrysostoma" "Neophema_pulchella"
[111] "Psittacula_krameri" "Eclectus_roratus"
[113] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[115] "Alisterus_amboinensis" "Polytelis_alexandrae"
[117] "Trichoglossus_haematodus" "Agapornis_lilianae"
[119] "Agapornis_taranta" "Loriculus_vernalis"
[121] "Ara_ararauna" "Guaruba_guarouba"
[123] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[125] "Forpus_coelestis" "Forpus_passerinus"
[127] "Amazona_leucocephala" "Amazona_albifrons"
[129] "Amazona_pretrei" "Amazona_vinacea"
[131] "Amazona_finschi" "Amazona_amazonica"
[133] "Amazona_ochrocephala" "Amazona_aestiva"
[135] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[137] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[139] "Poicephalus_meyeri" "Psittacus_erithacus"
[141] "Serinus_mennelli" "Ficedula_hypoleuca"
[143] "Padda_oryzivora" "Lonchura_punctulata"
[145] "Lonchura_flaviprymna" "Lonchura_bicolor"
[147] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[149] "Uraeginthus_bengalus" "Amandava_amandava"
[151] "Plectrophenax_nivalis" "Serinus_canaria"
[153] "Serinus_serinus" "Loxia_curvirostra"
[155] "Carduelis_carduelis" "Carpodacus_roseus"
[157] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[159] "Pinicola_enucleator" "Bucanetes_githagineus"
[161] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[163] "Mycerobas_carnipes" "Fringilla_montifringilla"
[165] "Fringilla_coelebs" "Anas_platyrhynchos"
[167] "Anas_acuta" "Anas_crecca"
[169] "Mergus_serrator" "Mergus_merganser"
[171] "Bucephala_clangula" "Melanitta_nigra"
[173] "Somateria_mollissima" "Callonetta_leucophrys"
[175] "Branta_bernicla" "Branta_leucopsis"
[177] "Anser_anser" "Cygnus_columbianus"
[179] "Tadorna_tadorna" "Coturnix_japonica"
[181] "Pucrasia_macrolopha" "Phasianus_colchicus"
[183] "Chrysolophus_pictus" "Lophura_nycthemera"
[185] "Lophura_ignita" "Syrmaticus_ellioti"
[187] "Syrmaticus_reevesii" "Perdix_perdix"
[189] "Tetrao_urogallus" "Lagopus_muta"
[191] "Lagopus_lagopus" "Lophophorus_impejanus"
[193] "Tragopan_temminckii" "Pavo_cristatus"
[195] "Gallus_gallus" "Gallus_sonneratii"
[197] "Rollulus_rouloul" "Arborophila_torqueola"
[199] "Numida_meleagris"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 5
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_pituitary_glands <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 3.9 seconds.
Chain 3 finished in 4.0 seconds.
Chain 1 finished in 4.7 seconds.
Chain 2 finished in 4.6 seconds.
All 4 chains finished successfully.
Mean chain execution time: 4.3 seconds.
Total execution time: 4.7 seconds.
pp_check(model_simple_pituitary_glands)summary(model_simple_pituitary_glands) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 10)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.31 0.32 0.01 1.19 1.00
sd(log10_body_size) 0.18 0.20 0.00 0.75 1.00
cor(Intercept,log10_body_size) -0.07 0.60 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 4018 3598
sd(log10_body_size) 1788 3113
cor(Intercept,log10_body_size) 4215 4178
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -3.74 0.34 -4.36 -2.98 1.00 4347 4113
log10_body_size 0.75 0.16 0.46 1.12 1.00 2277 1588
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.10 0.03 0.05 0.18 1.00 4141 4111
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_pituitary_glands)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_pituitary_glands)$sex)[[1]],
slope = coef(model_simple_pituitary_glands)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_pituitary_glands)$sex)[[1]],
slope_low = coef(model_simple_pituitary_glands)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_pituitary_glands)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -3.75 -4.20 -3.31 0.731 0.571 0.892
2 male -3.79 -4.21 -3.36 0.714 0.567 0.860
model_phylo_pituitary_glands <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 33.0 seconds.
Chain 4 finished in 43.5 seconds.
Chain 1 finished in 54.5 seconds.
Chain 3 finished in 96.6 seconds.
All 4 chains finished successfully.
Mean chain execution time: 56.9 seconds.
Total execution time: 96.8 seconds.
pp_check(model_phylo_pituitary_glands)summary(model_phylo_pituitary_glands) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 10)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 5)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.16 0.10 0.05 0.40 1.00 2063 2185
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.24 0.29 0.01 1.04 1.00
sd(log10_body_size) 0.18 0.20 0.00 0.73 1.00
cor(Intercept,log10_body_size) -0.05 0.61 -0.98 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 4165 4489
sd(log10_body_size) 2562 3028
cor(Intercept,log10_body_size) 5442 4775
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -3.83 0.45 -4.70 -2.92 1.00 2667 3522
log10_body_size 0.78 0.18 0.46 1.19 1.00 2415 2626
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.03 0.02 0.01 0.07 1.00 768 1777
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_pituitary_glands, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.49 0.35 0.01 0.99 0.32
Post.Prob Star
1 0.24 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_pituitary_glands <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_pituitary_glands)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_pituitary_glands)$sex)[[1]],
slope = coef(model_phylo_pituitary_glands)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_pituitary_glands)$sex)[[1]],
slope_low = coef(model_phylo_pituitary_glands)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_pituitary_glands)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -3.85 -4.64 -3.11 0.775 0.524 1.04
2 male -3.85 -4.56 -3.15 0.745 0.517 0.973
loo_simple <- loo(model_simple_pituitary_glands)
loo_phylo <- loo(model_phylo_pituitary_glands)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_pituitary_glands 0.0 0.0
model_simple_pituitary_glands -11.8 1.6
In this comparison, the phylogenetic model is clearly preferable to the model treating species as independent observational units. The phylogenetic model (model_phylo_pituitary_glands) serves as reference with elpd_diff = 0, while the simpler model (model_simple_pituitary_glands) has an expected log predictive density (ELPD) that is about 11.8 units lower, with an associated standard error of 1.6. In leave-one-out cross-validation, differences exceeding approximately four times their standard error indicate strong evidence. Here, 11.8/1.6≈7.4, indicating a large difference relative to its uncertainty, and thus providing evidence favouring the phylogenetic model.
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "spleen")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[93] "Erythrocebus_patas" "Papio_cynocephalus"
[95] "Papio_anubis" "Cercocebus_atys"
[97] "Macaca_arctoides" "Macaca_mulatta"
[99] "Macaca_maura" "Trachypithecus_francoisi"
[101] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[103] "Platycercus_elegans" "Platycercus_eximius"
[105] "Platycercus_venustus" "Barnardius_zonarius"
[107] "Northiella_haematogaster" "Lathamus_discolor"
[109] "Neophema_chrysostoma" "Neophema_pulchella"
[111] "Psittacula_krameri" "Eclectus_roratus"
[113] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[115] "Alisterus_amboinensis" "Polytelis_alexandrae"
[117] "Trichoglossus_haematodus" "Agapornis_lilianae"
[119] "Agapornis_taranta" "Loriculus_vernalis"
[121] "Ara_ararauna" "Guaruba_guarouba"
[123] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[125] "Forpus_coelestis" "Forpus_passerinus"
[127] "Amazona_leucocephala" "Amazona_albifrons"
[129] "Amazona_pretrei" "Amazona_vinacea"
[131] "Amazona_finschi" "Amazona_amazonica"
[133] "Amazona_ochrocephala" "Amazona_aestiva"
[135] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[137] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[139] "Poicephalus_meyeri" "Psittacus_erithacus"
[141] "Serinus_mennelli" "Padda_oryzivora"
[143] "Lonchura_punctulata" "Lonchura_flaviprymna"
[145] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[147] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[149] "Amandava_amandava" "Plectrophenax_nivalis"
[151] "Serinus_canaria" "Serinus_serinus"
[153] "Loxia_curvirostra" "Carduelis_carduelis"
[155] "Carpodacus_roseus" "Uragus_sibiricus"
[157] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[159] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[161] "Mycerobas_affinis" "Mycerobas_carnipes"
[163] "Fringilla_montifringilla" "Fringilla_coelebs"
[165] "Anas_acuta" "Anas_crecca"
[167] "Mergus_serrator" "Mergus_merganser"
[169] "Bucephala_clangula" "Melanitta_nigra"
[171] "Somateria_mollissima" "Callonetta_leucophrys"
[173] "Branta_bernicla" "Branta_leucopsis"
[175] "Anser_anser" "Cygnus_columbianus"
[177] "Tadorna_tadorna" "Pucrasia_macrolopha"
[179] "Phasianus_colchicus" "Chrysolophus_pictus"
[181] "Lophura_nycthemera" "Lophura_ignita"
[183] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[185] "Perdix_perdix" "Tetrao_urogallus"
[187] "Lagopus_muta" "Lagopus_lagopus"
[189] "Lophophorus_impejanus" "Tragopan_temminckii"
[191] "Pavo_cristatus" "Gallus_sonneratii"
[193] "Rollulus_rouloul" "Arborophila_torqueola"
[195] "Numida_meleagris"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 9
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_spleen <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 1.4 seconds.
Chain 2 finished in 2.0 seconds.
Chain 4 finished in 2.1 seconds.
Chain 3 finished in 2.5 seconds.
All 4 chains finished successfully.
Mean chain execution time: 2.0 seconds.
Total execution time: 2.7 seconds.
pp_check(model_simple_spleen)summary(model_simple_spleen) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 18)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.32 0.32 0.01 1.14 1.00
sd(log10_body_size) 0.20 0.22 0.00 0.82 1.00
cor(Intercept,log10_body_size) -0.10 0.59 -0.97 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3318 3175
sd(log10_body_size) 2302 3173
cor(Intercept,log10_body_size) 4118 4275
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -3.01 0.39 -3.77 -2.18 1.00 4839 4271
log10_body_size 0.99 0.18 0.60 1.34 1.00 2407 1968
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.38 0.08 0.27 0.56 1.00 5903 4940
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_spleen)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_spleen)$sex)[[1]],
slope = coef(model_simple_spleen)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_spleen)$sex)[[1]],
slope_low = coef(model_simple_spleen)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_spleen)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -3.01 -3.58 -2.43 1.01 0.771 1.24
2 male -3.06 -3.63 -2.49 1.02 0.787 1.25
model_phylo_spleen <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 15.2 seconds.
Chain 2 finished in 15.4 seconds.
Chain 1 finished in 20.5 seconds.
Chain 3 finished in 26.5 seconds.
All 4 chains finished successfully.
Mean chain execution time: 19.4 seconds.
Total execution time: 26.6 seconds.
pp_check(model_phylo_spleen)summary(model_phylo_spleen) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 18)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 9)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 1.18 0.37 0.57 2.02 1.00 1063 691
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.29 0.30 0.01 1.10 1.00
sd(log10_body_size) 0.18 0.23 0.00 0.76 1.00
cor(Intercept,log10_body_size) -0.12 0.59 -0.98 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3272 3361
sd(log10_body_size) 2506 3534
cor(Intercept,log10_body_size) 5019 4860
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.76 0.89 -4.42 -0.83 1.00 2431 3941
log10_body_size 0.91 0.22 0.46 1.34 1.00 2433 3989
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.09 0.05 0.04 0.25 1.00 779 625
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_spleen, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.89 0.16 0.37 1 0.01
Post.Prob Star
1 0.01 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_spleen <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_spleen)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_spleen)$sex)[[1]],
slope = coef(model_phylo_spleen)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_spleen)$sex)[[1]],
slope_low = coef(model_phylo_spleen)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_spleen)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.71 -4.35 -0.851 0.906 0.494 1.26
2 male -2.81 -4.43 -0.965 0.937 0.547 1.28
loo_simple <- loo(model_simple_spleen)
loo_phylo <- loo(model_phylo_spleen)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_spleen 0.0 0.0
model_simple_spleen -21.4 1.3
In this comparison, the phylogenetic model is clearly preferable to the model treating species as independent observational units. The phylogenetic model (model_phylo_spleen) serves as reference with elpd_diff = 0, while the simpler model (model_simple_spleen) has an expected log predictive density (ELPD) 21.4 units lower, with an associated standard error of 1.3. In leave-one-out cross-validation, differences exceeding approximately four times their standard error indicate strong evidence. Here, 21.4/1.3≈16, indicating a very large difference relative to its uncertainty, and thus providing very strong evidence favouring the phylogenetic model.
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "stomach")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Rattus_norvegicus" "Chlorocebus_aethiops"
[93] "Chlorocebus_sabaeus" "Erythrocebus_patas"
[95] "Papio_cynocephalus" "Papio_anubis"
[97] "Cercocebus_atys" "Macaca_arctoides"
[99] "Macaca_mulatta" "Macaca_fascicularis"
[101] "Macaca_maura" "Trachypithecus_francoisi"
[103] "Platycercus_caledonicus" "Platycercus_elegans"
[105] "Platycercus_eximius" "Platycercus_venustus"
[107] "Barnardius_zonarius" "Northiella_haematogaster"
[109] "Lathamus_discolor" "Neophema_chrysostoma"
[111] "Neophema_pulchella" "Psittacula_krameri"
[113] "Eclectus_roratus" "Aprosmictus_jonquillaceus"
[115] "Alisterus_scapularis" "Alisterus_amboinensis"
[117] "Polytelis_alexandrae" "Trichoglossus_haematodus"
[119] "Agapornis_lilianae" "Agapornis_taranta"
[121] "Loriculus_vernalis" "Ara_ararauna"
[123] "Guaruba_guarouba" "Enicognathus_leptorhynchus"
[125] "Pionites_melanocephalus" "Forpus_coelestis"
[127] "Forpus_passerinus" "Amazona_leucocephala"
[129] "Amazona_albifrons" "Amazona_pretrei"
[131] "Amazona_vinacea" "Amazona_finschi"
[133] "Amazona_amazonica" "Amazona_ochrocephala"
[135] "Amazona_aestiva" "Brotogeris_versicolurus"
[137] "Brotogeris_pyrrhoptera" "Bolborhynchus_lineola"
[139] "Poicephalus_gulielmi" "Poicephalus_meyeri"
[141] "Psittacus_erithacus" "Serinus_mennelli"
[143] "Ficedula_hypoleuca" "Padda_oryzivora"
[145] "Lonchura_punctulata" "Lonchura_flaviprymna"
[147] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[149] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[151] "Amandava_amandava" "Plectrophenax_nivalis"
[153] "Serinus_canaria" "Serinus_serinus"
[155] "Loxia_curvirostra" "Carduelis_carduelis"
[157] "Carpodacus_roseus" "Uragus_sibiricus"
[159] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[161] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[163] "Mycerobas_affinis" "Mycerobas_carnipes"
[165] "Fringilla_montifringilla" "Fringilla_coelebs"
[167] "Anas_acuta" "Anas_crecca"
[169] "Mergus_serrator" "Mergus_merganser"
[171] "Bucephala_clangula" "Melanitta_nigra"
[173] "Somateria_mollissima" "Callonetta_leucophrys"
[175] "Branta_bernicla" "Branta_leucopsis"
[177] "Anser_anser" "Cygnus_columbianus"
[179] "Tadorna_tadorna" "Pucrasia_macrolopha"
[181] "Phasianus_colchicus" "Chrysolophus_pictus"
[183] "Lophura_nycthemera" "Lophura_ignita"
[185] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[187] "Perdix_perdix" "Tetrao_urogallus"
[189] "Lagopus_muta" "Lagopus_lagopus"
[191] "Lophophorus_impejanus" "Tragopan_temminckii"
[193] "Pavo_cristatus" "Gallus_sonneratii"
[195] "Rollulus_rouloul" "Arborophila_torqueola"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 8
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_stomach <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 2.4 seconds.
Chain 3 finished in 2.5 seconds.
Chain 2 finished in 2.6 seconds.
Chain 4 finished in 2.6 seconds.
All 4 chains finished successfully.
Mean chain execution time: 2.5 seconds.
Total execution time: 2.8 seconds.
pp_check(model_simple_stomach)summary(model_simple_stomach) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 16)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.29 0.30 0.01 1.08 1.00
sd(log10_body_size) 0.20 0.23 0.00 0.84 1.00
cor(Intercept,log10_body_size) -0.09 0.60 -0.98 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3636 3639
sd(log10_body_size) 1837 3384
cor(Intercept,log10_body_size) 3837 4182
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.63 0.33 -3.28 -1.95 1.00 4295 3726
log10_body_size 1.18 0.18 0.71 1.48 1.00 2080 1216
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.23 0.05 0.15 0.35 1.00 5037 3724
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_stomach)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_stomach)$sex)[[1]],
slope = coef(model_simple_stomach)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_stomach)$sex)[[1]],
slope_low = coef(model_simple_stomach)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_stomach)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.63 -3.03 -2.22 1.23 1.05 1.39
2 male -2.64 -3.04 -2.23 1.23 1.06 1.39
model_phylo_stomach <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 14.5 seconds.
Chain 1 finished in 16.7 seconds.
Chain 4 finished in 17.1 seconds.
Chain 3 finished in 22.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 17.6 seconds.
Total execution time: 22.2 seconds.
pp_check(model_phylo_stomach)summary(model_phylo_stomach) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 16)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 8)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.39 0.13 0.22 0.70 1.00 2453 4006
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.21 0.27 0.00 0.93 1.00
sd(log10_body_size) 0.13 0.18 0.00 0.63 1.00
cor(Intercept,log10_body_size) -0.05 0.62 -0.98 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3348 3977
sd(log10_body_size) 2424 3143
cor(Intercept,log10_body_size) 5595 5115
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.96 0.42 -2.74 -1.09 1.00 3111 3808
log10_body_size 0.87 0.17 0.52 1.20 1.00 2549 3676
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.04 0.02 0.02 0.08 1.00 2226 3234
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_stomach, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.77 0.26 0.12 0.99 0.02
Post.Prob Star
1 0.02 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_stomach <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_stomach)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_stomach)$sex)[[1]],
slope = coef(model_phylo_stomach)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_stomach)$sex)[[1]],
slope_low = coef(model_phylo_stomach)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_stomach)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.94 -2.63 -1.17 0.872 0.586 1.12
2 male -1.97 -2.65 -1.21 0.878 0.594 1.13
loo_simple <- loo(model_simple_stomach)
loo_phylo <- loo(model_phylo_stomach)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_stomach 0.0 0.0
model_simple_stomach -23.3 3.6
In this comparison, the phylogenetic model is clearly preferable to the model treating species as independent observational units. The phylogenetic model (model_phylo_stomach) is used as the reference with elpd_diff = 0, while the simpler model (model_simple_stomach) has an expected log predictive density (ELPD) that is about 23.3 units lower, with an associated standard error of 3.6. In leave-one-out cross-validation, differences exceeding approximately four times their standard error indicate strong evidence. Here, 23.3/3.6≈6.5, providing strong evidence favouring the phylogenetic model..
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "lungs")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[93] "Erythrocebus_patas" "Papio_cynocephalus"
[95] "Papio_anubis" "Cercocebus_atys"
[97] "Macaca_arctoides" "Macaca_mulatta"
[99] "Macaca_maura" "Trachypithecus_francoisi"
[101] "Platycercus_caledonicus" "Platycercus_elegans"
[103] "Platycercus_eximius" "Platycercus_venustus"
[105] "Barnardius_zonarius" "Northiella_haematogaster"
[107] "Lathamus_discolor" "Neophema_chrysostoma"
[109] "Neophema_pulchella" "Psittacula_krameri"
[111] "Eclectus_roratus" "Aprosmictus_jonquillaceus"
[113] "Alisterus_scapularis" "Alisterus_amboinensis"
[115] "Polytelis_alexandrae" "Trichoglossus_haematodus"
[117] "Agapornis_lilianae" "Agapornis_taranta"
[119] "Loriculus_vernalis" "Ara_ararauna"
[121] "Guaruba_guarouba" "Enicognathus_leptorhynchus"
[123] "Pionites_melanocephalus" "Forpus_coelestis"
[125] "Forpus_passerinus" "Amazona_leucocephala"
[127] "Amazona_albifrons" "Amazona_pretrei"
[129] "Amazona_vinacea" "Amazona_finschi"
[131] "Amazona_amazonica" "Amazona_ochrocephala"
[133] "Amazona_aestiva" "Brotogeris_versicolurus"
[135] "Brotogeris_pyrrhoptera" "Bolborhynchus_lineola"
[137] "Poicephalus_gulielmi" "Poicephalus_meyeri"
[139] "Psittacus_erithacus" "Serinus_mennelli"
[141] "Ficedula_hypoleuca" "Padda_oryzivora"
[143] "Lonchura_punctulata" "Lonchura_flaviprymna"
[145] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[147] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[149] "Amandava_amandava" "Plectrophenax_nivalis"
[151] "Serinus_canaria" "Serinus_serinus"
[153] "Loxia_curvirostra" "Carduelis_carduelis"
[155] "Carpodacus_roseus" "Uragus_sibiricus"
[157] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[159] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[161] "Mycerobas_affinis" "Mycerobas_carnipes"
[163] "Fringilla_montifringilla" "Fringilla_coelebs"
[165] "Anas_platyrhynchos" "Anas_acuta"
[167] "Anas_crecca" "Mergus_serrator"
[169] "Mergus_merganser" "Bucephala_clangula"
[171] "Melanitta_nigra" "Somateria_mollissima"
[173] "Callonetta_leucophrys" "Branta_bernicla"
[175] "Branta_leucopsis" "Anser_anser"
[177] "Cygnus_columbianus" "Tadorna_tadorna"
[179] "Coturnix_japonica" "Pucrasia_macrolopha"
[181] "Phasianus_colchicus" "Chrysolophus_pictus"
[183] "Lophura_nycthemera" "Lophura_ignita"
[185] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[187] "Perdix_perdix" "Tetrao_urogallus"
[189] "Lagopus_muta" "Lagopus_lagopus"
[191] "Lophophorus_impejanus" "Tragopan_temminckii"
[193] "Pavo_cristatus" "Gallus_gallus"
[195] "Gallus_sonneratii" "Rollulus_rouloul"
[197] "Arborophila_torqueola" "Numida_meleagris"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 6
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_lungs <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 1.9 seconds.
Chain 4 finished in 1.7 seconds.
Chain 3 finished in 2.0 seconds.
Chain 2 finished in 2.3 seconds.
All 4 chains finished successfully.
Mean chain execution time: 2.0 seconds.
Total execution time: 2.3 seconds.
pp_check(model_simple_lungs)summary(model_simple_lungs) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 12)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.31 0.33 0.01 1.16 1.00
sd(log10_body_size) 0.21 0.23 0.00 0.81 1.00
cor(Intercept,log10_body_size) -0.08 0.60 -0.97 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3402 3559
sd(log10_body_size) 2134 2245
cor(Intercept,log10_body_size) 3557 4522
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.52 0.36 -3.22 -1.75 1.00 4350 4283
log10_body_size 1.05 0.19 0.60 1.38 1.00 2581 2303
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.27 0.08 0.17 0.46 1.00 4371 4081
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_lungs)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_lungs)$sex)[[1]],
slope = coef(model_simple_lungs)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_lungs)$sex)[[1]],
slope_low = coef(model_simple_lungs)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_lungs)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.54 -3.04 -2.03 1.10 0.858 1.33
2 male -2.52 -3.01 -2.00 1.07 0.838 1.28
model_phylo_lungs <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 9.9 seconds.
Chain 2 finished in 11.0 seconds.
Chain 3 finished in 13.1 seconds.
Chain 4 finished in 13.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 11.7 seconds.
Total execution time: 13.3 seconds.
pp_check(model_phylo_lungs)summary(model_phylo_lungs) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 12)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.47 0.23 0.18 1.07 1.00 1790 3470
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.29 0.30 0.01 1.10 1.00
sd(log10_body_size) 0.21 0.23 0.01 0.81 1.00
cor(Intercept,log10_body_size) -0.12 0.59 -0.98 0.93 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2725 2891
sd(log10_body_size) 2128 2871
cor(Intercept,log10_body_size) 5703 4758
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.39 0.53 -3.37 -1.23 1.00 3691 3976
log10_body_size 0.93 0.20 0.49 1.31 1.00 3113 3672
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.08 0.04 0.03 0.17 1.00 1198 3053
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_lungs, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.69 0.28 0.08 0.99 0.04
Post.Prob Star
1 0.04 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_lungs <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_lungs)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_lungs)$sex)[[1]],
slope = coef(model_phylo_lungs)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_lungs)$sex)[[1]],
slope_low = coef(model_phylo_lungs)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_lungs)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.45 -3.28 -1.39 0.978 0.647 1.23
2 male -2.35 -3.19 -1.33 0.919 0.614 1.15
loo_simple <- loo(model_simple_lungs)
loo_phylo <- loo(model_phylo_lungs)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_lungs 0.0 0.0
model_simple_lungs -12.7 1.4
In this comparison, the model that accounts for phylogeny is clearly preferable to the model that treats species as independent observational units. The phylogenetic model (model_phylo_lungs) is used as the reference with elpd_diff = 0, while the simpler model (model_simple_lungs) has an expected log predictive density (ELPD) that is about 12.7 units lower, with an associated standard error of 1.4. In the context of leave‑one‑out cross‑validation, differences exceeding roughly four times their standard error are typically regarded as strong evidence. Here, 12.7/1.4≈9.1, indicating a very large difference relative to its uncertainty, and thus providing strong support for the phylogenetic model.
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "adrenal glands")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Lasiopodomys_brandtii" "Meriones_unguiculatus"
[93] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[95] "Erythrocebus_patas" "Papio_cynocephalus"
[97] "Papio_anubis" "Cercocebus_atys"
[99] "Macaca_arctoides" "Macaca_mulatta"
[101] "Macaca_maura" "Trachypithecus_francoisi"
[103] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[105] "Platycercus_elegans" "Platycercus_eximius"
[107] "Platycercus_venustus" "Barnardius_zonarius"
[109] "Northiella_haematogaster" "Lathamus_discolor"
[111] "Neophema_chrysostoma" "Neophema_pulchella"
[113] "Psittacula_krameri" "Eclectus_roratus"
[115] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[117] "Alisterus_amboinensis" "Polytelis_alexandrae"
[119] "Trichoglossus_haematodus" "Agapornis_lilianae"
[121] "Agapornis_taranta" "Loriculus_vernalis"
[123] "Ara_ararauna" "Guaruba_guarouba"
[125] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[127] "Forpus_coelestis" "Forpus_passerinus"
[129] "Amazona_leucocephala" "Amazona_albifrons"
[131] "Amazona_pretrei" "Amazona_vinacea"
[133] "Amazona_finschi" "Amazona_amazonica"
[135] "Amazona_ochrocephala" "Amazona_aestiva"
[137] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[139] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[141] "Poicephalus_meyeri" "Psittacus_erithacus"
[143] "Serinus_mennelli" "Ficedula_hypoleuca"
[145] "Padda_oryzivora" "Lonchura_punctulata"
[147] "Lonchura_flaviprymna" "Lonchura_bicolor"
[149] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[151] "Uraeginthus_bengalus" "Amandava_amandava"
[153] "Plectrophenax_nivalis" "Serinus_canaria"
[155] "Serinus_serinus" "Loxia_curvirostra"
[157] "Carduelis_carduelis" "Carpodacus_roseus"
[159] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[161] "Pinicola_enucleator" "Bucanetes_githagineus"
[163] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[165] "Mycerobas_carnipes" "Fringilla_montifringilla"
[167] "Fringilla_coelebs" "Anas_acuta"
[169] "Anas_crecca" "Mergus_serrator"
[171] "Mergus_merganser" "Bucephala_clangula"
[173] "Melanitta_nigra" "Somateria_mollissima"
[175] "Callonetta_leucophrys" "Branta_bernicla"
[177] "Branta_leucopsis" "Anser_anser"
[179] "Cygnus_columbianus" "Tadorna_tadorna"
[181] "Pucrasia_macrolopha" "Phasianus_colchicus"
[183] "Chrysolophus_pictus" "Lophura_nycthemera"
[185] "Lophura_ignita" "Syrmaticus_ellioti"
[187] "Syrmaticus_reevesii" "Perdix_perdix"
[189] "Tetrao_urogallus" "Lagopus_muta"
[191] "Lagopus_lagopus" "Lophophorus_impejanus"
[193] "Tragopan_temminckii" "Pavo_cristatus"
[195] "Gallus_gallus" "Gallus_sonneratii"
[197] "Rollulus_rouloul" "Arborophila_torqueola"
[199] "Numida_meleagris"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 5
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_adrenal_glands <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 1.5 seconds.
Chain 1 finished in 1.7 seconds.
Chain 2 finished in 1.9 seconds.
Chain 3 finished in 1.8 seconds.
All 4 chains finished successfully.
Mean chain execution time: 1.7 seconds.
Total execution time: 2.1 seconds.
pp_check(model_simple_adrenal_glands)summary(model_simple_adrenal_glands) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 10)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.32 0.33 0.01 1.18 1.00
sd(log10_body_size) 0.20 0.22 0.01 0.80 1.00
cor(Intercept,log10_body_size) -0.11 0.59 -0.98 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3565 2537
sd(log10_body_size) 2615 3544
cor(Intercept,log10_body_size) 3227 3452
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -3.00 0.37 -3.72 -2.24 1.00 4586 4119
log10_body_size 0.74 0.17 0.41 1.11 1.00 2893 2630
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.26 0.09 0.15 0.48 1.00 3971 3995
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_adrenal_glands)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_adrenal_glands)$sex)[[1]],
slope = coef(model_simple_adrenal_glands)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_adrenal_glands)$sex)[[1]],
slope_low = coef(model_simple_adrenal_glands)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_adrenal_glands)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.99 -3.54 -2.44 0.720 0.508 0.926
2 male -3.05 -3.59 -2.50 0.727 0.520 0.932
model_phylo_adrenal_glands <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 3.5 seconds.
Chain 3 finished in 3.9 seconds.
Chain 1 finished in 4.0 seconds.
Chain 4 finished in 4.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 3.9 seconds.
Total execution time: 4.2 seconds.
pp_check(model_phylo_adrenal_glands)summary(model_phylo_adrenal_glands) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 10)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 5)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.35 0.23 0.02 0.92 1.00 2085 2237
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.31 0.32 0.01 1.14 1.00
sd(log10_body_size) 0.19 0.22 0.00 0.80 1.00
cor(Intercept,log10_body_size) -0.09 0.60 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 4236 3612
sd(log10_body_size) 2443 4133
cor(Intercept,log10_body_size) 5135 4652
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -3.05 0.47 -4.01 -2.06 1.00 4480 4249
log10_body_size 0.76 0.18 0.41 1.16 1.00 2808 2514
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.18 0.09 0.08 0.39 1.00 2083 3940
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_adrenal_glands, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.47 0.32 0 0.96 0.32
Post.Prob Star
1 0.24 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_adrenal_glands <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_adrenal_glands)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_adrenal_glands)$sex)[[1]],
slope = coef(model_phylo_adrenal_glands)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_adrenal_glands)$sex)[[1]],
slope_low = coef(model_phylo_adrenal_glands)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_adrenal_glands)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -3.03 -3.84 -2.22 0.743 0.519 0.968
2 male -3.11 -3.91 -2.32 0.755 0.537 0.976
loo_simple <- loo(model_simple_adrenal_glands)
loo_phylo <- loo(model_phylo_adrenal_glands)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_adrenal_glands 0.0 0.0
model_simple_adrenal_glands -2.6 0.7
In this comparison, the model that accounts for phylogeny is clearly preferable to the model that treats species as independent observational units. The phylogenetic model (model_phylo_adrenal glands) is used as the reference with elpd_diff = 0, whereas the simpler model (model_simple_adrenal glands) has an expected log predictive density (ELPD) that is about 2.6 units lower, with an associated standard error of 0.7 In the context of leave‑one‑out cross‑validation, differences exceeding roughly four times their standard error are typically regarded as strong evidence. Here, 2.6/0.7≈3.7, indicating both models are similarly good.
# Filter organ of interest
dat_organ <- dat_mean %>%
group_by(organ_grouped, sex) %>%
ungroup() %>%
filter(organ_grouped == "kidneys")
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[93] "Erythrocebus_patas" "Papio_cynocephalus"
[95] "Papio_anubis" "Cercocebus_atys"
[97] "Macaca_arctoides" "Macaca_mulatta"
[99] "Macaca_maura" "Trachypithecus_francoisi"
[101] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[103] "Platycercus_elegans" "Platycercus_eximius"
[105] "Platycercus_venustus" "Barnardius_zonarius"
[107] "Northiella_haematogaster" "Lathamus_discolor"
[109] "Neophema_chrysostoma" "Neophema_pulchella"
[111] "Psittacula_krameri" "Eclectus_roratus"
[113] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[115] "Alisterus_amboinensis" "Polytelis_alexandrae"
[117] "Trichoglossus_haematodus" "Agapornis_lilianae"
[119] "Agapornis_taranta" "Loriculus_vernalis"
[121] "Ara_ararauna" "Guaruba_guarouba"
[123] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[125] "Forpus_coelestis" "Forpus_passerinus"
[127] "Amazona_leucocephala" "Amazona_albifrons"
[129] "Amazona_pretrei" "Amazona_vinacea"
[131] "Amazona_finschi" "Amazona_amazonica"
[133] "Amazona_ochrocephala" "Amazona_aestiva"
[135] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[137] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[139] "Poicephalus_meyeri" "Psittacus_erithacus"
[141] "Serinus_mennelli" "Ficedula_hypoleuca"
[143] "Padda_oryzivora" "Lonchura_punctulata"
[145] "Lonchura_flaviprymna" "Lonchura_bicolor"
[147] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[149] "Uraeginthus_bengalus" "Amandava_amandava"
[151] "Plectrophenax_nivalis" "Serinus_canaria"
[153] "Serinus_serinus" "Loxia_curvirostra"
[155] "Carduelis_carduelis" "Carpodacus_roseus"
[157] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[159] "Pinicola_enucleator" "Bucanetes_githagineus"
[161] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[163] "Mycerobas_carnipes" "Fringilla_montifringilla"
[165] "Fringilla_coelebs" "Anas_acuta"
[167] "Anas_crecca" "Mergus_serrator"
[169] "Mergus_merganser" "Bucephala_clangula"
[171] "Melanitta_nigra" "Somateria_mollissima"
[173] "Callonetta_leucophrys" "Branta_bernicla"
[175] "Branta_leucopsis" "Anser_anser"
[177] "Cygnus_columbianus" "Tadorna_tadorna"
[179] "Coturnix_japonica" "Pucrasia_macrolopha"
[181] "Phasianus_colchicus" "Chrysolophus_pictus"
[183] "Lophura_nycthemera" "Lophura_ignita"
[185] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[187] "Perdix_perdix" "Tetrao_urogallus"
[189] "Lagopus_muta" "Lagopus_lagopus"
[191] "Lophophorus_impejanus" "Tragopan_temminckii"
[193] "Pavo_cristatus" "Gallus_gallus"
[195] "Gallus_sonneratii" "Rollulus_rouloul"
[197] "Arborophila_torqueola" "Numida_meleagris"
setdiff(dat_organ$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ$phylo))
dat_organ <- dat_organ[dat_organ$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ$phylo)character(0)
setdiff(dat_organ$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 6
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_kidneys <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 3.6 seconds.
Chain 1 finished in 4.1 seconds.
Chain 2 finished in 6.7 seconds.
Chain 3 finished in 7.4 seconds.
All 4 chains finished successfully.
Mean chain execution time: 5.5 seconds.
Total execution time: 7.5 seconds.
pp_check(model_simple_kidneys)summary(model_simple_kidneys) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ (Number of observations: 12)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.25 0.30 0.01 1.06 1.00
sd(log10_body_size) 0.16 0.21 0.00 0.73 1.00
cor(Intercept,log10_body_size) -0.06 0.61 -0.98 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2652 3441
sd(log10_body_size) 2110 3759
cor(Intercept,log10_body_size) 4028 4228
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.69 0.27 -2.22 -1.15 1.00 3154 3098
log10_body_size 0.82 0.13 0.52 1.11 1.00 1875 1832
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.09 0.03 0.06 0.16 1.00 4773 3864
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_kidneys)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_kidneys)$sex)[[1]],
slope = coef(model_simple_kidneys)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_kidneys)$sex)[[1]],
slope_low = coef(model_simple_kidneys)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_kidneys)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.70 -1.89 -1.52 0.824 0.750 0.903
2 male -1.68 -1.87 -1.49 0.817 0.744 0.890
model_phylo_kidneys <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 16.0 seconds.
Chain 4 finished in 16.4 seconds.
Chain 3 finished in 20.6 seconds.
Chain 2 finished in 23.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 19.0 seconds.
Total execution time: 23.1 seconds.
pp_check(model_phylo_kidneys)summary(model_phylo_kidneys) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ (Number of observations: 12)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.27 0.14 0.07 0.62 1.00 1436 1448
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.21 0.26 0.00 0.95 1.00
sd(log10_body_size) 0.12 0.17 0.00 0.60 1.00
cor(Intercept,log10_body_size) -0.07 0.62 -0.98 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3254 3972
sd(log10_body_size) 2187 3539
cor(Intercept,log10_body_size) 5530 4291
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.52 0.33 -2.20 -0.83 1.00 3327 3840
log10_body_size 0.76 0.12 0.49 1.01 1.00 2975 2672
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.03 0.02 0.01 0.09 1.00 1149 1457
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_kidneys, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.65 0.32 0.03 0.99 0.12
Post.Prob Star
1 0.11 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_kidneys <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_kidneys)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_kidneys)$sex)[[1]],
slope = coef(model_phylo_kidneys)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_kidneys)$sex)[[1]],
slope_low = coef(model_phylo_kidneys)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_kidneys)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.53 -2.06 -0.971 0.773 0.649 0.895
2 male -1.50 -2.03 -0.946 0.766 0.646 0.880
loo_simple <- loo(model_simple_kidneys)
loo_phylo <- loo(model_phylo_kidneys)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_kidneys 0.0 0.0
model_simple_kidneys -10.3 1.5
In this comparison, the phylogenetic model is clearly preferable to the model treating species as independent observational units. The phylogenetic model (model_phylo_kidneys) serves as reference with elpd_diff = 0, while the simpler model (model_simple_kidneys) has an expected log predictive density (ELPD) that is about 10.3 units lower, with an associated standard error of 1.5. In leave-one-out cross-validation, differences exceeding approximately four times their standard error indicate strong evidence. Here, 10.3/1.5≈6.9, providing strong evidence favouring the phylogenetic model.
# Identify qualifying families (>10 unique species per family)
good_families_all <- dat_mean %>%
filter(organ_grouped == "brain") %>% # Brain organ only
group_by(class, family) %>%
summarise(n_species = n_distinct(species), .groups = "drop") %>%
filter(n_species > 10) %>% # species threshold
pull(family)
# Filter main dataset - preserves all measurements for qualifying families
dat_brain_all <- dat_mean %>%
filter(organ_grouped == "brain",
family %in% good_families_all)
# families per class, order and family
dat_brain_all %>%
distinct(class, order, family, species, .keep_all = TRUE) %>%
count(class, order, family, name = "n_species_unique") %>%
arrange(class, desc(n_species_unique))# A tibble: 8 × 4
class order family n_species_unique
<fct> <fct> <fct> <int>
1 Aves Psittaciformes Psittacidae 39
2 Aves Galliformes Phasianidae 17
3 Aves Passeriformes Fringillidae 16
4 Aves Anseriformes Anatidae 14
5 Mammalia Cetartiodactyla Bovidae 17
6 Mammalia Primates Cercopithecidae 11
7 Teleostei Perciformes Cichlidae 52
8 Teleostei Syngnathiformes Syngnathidae 15
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_brain_all$phylo) # Tree species absent in database [1] "Oreochromis_niloticus" "Poecilia_reticulata"
[3] "Anguilla_anguilla" "Pteropus_alecto"
[5] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[7] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[9] "Mus_musculus" "Meriones_unguiculatus"
[11] "Phrynocephalus_vlangalii" "Ficedula_hypoleuca"
[13] "Padda_oryzivora" "Lonchura_punctulata"
[15] "Lonchura_flaviprymna" "Lonchura_bicolor"
[17] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[19] "Uraeginthus_bengalus" "Amandava_amandava"
[21] "Coturnix_japonica" "Gallus_gallus"
[23] "Numida_meleagris"
setdiff(dat_brain_all$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_brain_all$phylo))
dat_brain_all <- dat_brain_all[dat_brain_all$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_brain_all$phylo)character(0)
setdiff(dat_brain_all$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 181
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)# Filter full data to those families only
dat_organ_Cichlidae <- dat_brain_all %>%
filter(family == "Cichlidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Cichlidae$phylo) # Tree species absent in database [1] "Oreochromis_niloticus" "Poecilia_reticulata"
[3] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[5] "Syngnathus_schlegeli" "Hippocampus_comes"
[7] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[9] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[11] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[13] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[15] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[17] "Entelurus_aequoreus" "Anguilla_anguilla"
[19] "Syncerus_caffer" "Tragelaphus_eurycerus"
[21] "Tragelaphus_scriptus" "Redunca_arundinum"
[23] "Antidorcas_marsupialis" "Nanger_granti"
[25] "Raphicerus_campestris" "Cephalophus_natalensis"
[27] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[29] "Hippotragus_equinus" "Addax_nasomaculatus"
[31] "Oryx_gazella" "Connochaetes_taurinus"
[33] "Damaliscus_lunatus" "Ovis_aries"
[35] "Aepyceros_melampus" "Pteropus_alecto"
[37] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[39] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[41] "Mus_musculus" "Meriones_unguiculatus"
[43] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[45] "Erythrocebus_patas" "Papio_cynocephalus"
[47] "Papio_anubis" "Cercocebus_atys"
[49] "Macaca_arctoides" "Macaca_mulatta"
[51] "Macaca_fascicularis" "Macaca_maura"
[53] "Trachypithecus_francoisi" "Phrynocephalus_vlangalii"
[55] "Platycercus_caledonicus" "Platycercus_elegans"
[57] "Platycercus_eximius" "Platycercus_venustus"
[59] "Barnardius_zonarius" "Northiella_haematogaster"
[61] "Lathamus_discolor" "Neophema_chrysostoma"
[63] "Neophema_pulchella" "Psittacula_krameri"
[65] "Eclectus_roratus" "Aprosmictus_jonquillaceus"
[67] "Alisterus_scapularis" "Alisterus_amboinensis"
[69] "Polytelis_alexandrae" "Trichoglossus_haematodus"
[71] "Agapornis_lilianae" "Agapornis_taranta"
[73] "Loriculus_vernalis" "Ara_ararauna"
[75] "Guaruba_guarouba" "Enicognathus_leptorhynchus"
[77] "Pionites_melanocephalus" "Forpus_coelestis"
[79] "Forpus_passerinus" "Amazona_leucocephala"
[81] "Amazona_albifrons" "Amazona_pretrei"
[83] "Amazona_vinacea" "Amazona_finschi"
[85] "Amazona_amazonica" "Amazona_ochrocephala"
[87] "Amazona_aestiva" "Brotogeris_versicolurus"
[89] "Brotogeris_pyrrhoptera" "Bolborhynchus_lineola"
[91] "Poicephalus_gulielmi" "Poicephalus_meyeri"
[93] "Psittacus_erithacus" "Serinus_mennelli"
[95] "Ficedula_hypoleuca" "Padda_oryzivora"
[97] "Lonchura_punctulata" "Lonchura_flaviprymna"
[99] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[101] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[103] "Amandava_amandava" "Plectrophenax_nivalis"
[105] "Serinus_canaria" "Serinus_serinus"
[107] "Loxia_curvirostra" "Carduelis_carduelis"
[109] "Carpodacus_roseus" "Uragus_sibiricus"
[111] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[113] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[115] "Mycerobas_affinis" "Mycerobas_carnipes"
[117] "Fringilla_montifringilla" "Fringilla_coelebs"
[119] "Anas_platyrhynchos" "Anas_acuta"
[121] "Anas_crecca" "Mergus_serrator"
[123] "Mergus_merganser" "Bucephala_clangula"
[125] "Melanitta_nigra" "Somateria_mollissima"
[127] "Callonetta_leucophrys" "Branta_bernicla"
[129] "Branta_leucopsis" "Anser_anser"
[131] "Cygnus_columbianus" "Tadorna_tadorna"
[133] "Coturnix_japonica" "Pucrasia_macrolopha"
[135] "Phasianus_colchicus" "Chrysolophus_pictus"
[137] "Lophura_nycthemera" "Lophura_ignita"
[139] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[141] "Perdix_perdix" "Tetrao_urogallus"
[143] "Lagopus_muta" "Lagopus_lagopus"
[145] "Lophophorus_impejanus" "Tragopan_temminckii"
[147] "Pavo_cristatus" "Gallus_gallus"
[149] "Gallus_sonneratii" "Rollulus_rouloul"
[151] "Arborophila_torqueola" "Numida_meleagris"
setdiff(dat_organ_Cichlidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Cichlidae$phylo))
dat_organ_Cichlidae <- dat_organ_Cichlidae[dat_organ_Cichlidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Cichlidae$phylo)character(0)
setdiff(dat_organ_Cichlidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 52
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Cichlidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Cichlidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 14.7 seconds.
Chain 3 finished in 17.9 seconds.
Chain 4 finished in 29.8 seconds.
Chain 2 finished in 42.6 seconds.
All 4 chains finished successfully.
Mean chain execution time: 26.3 seconds.
Total execution time: 42.8 seconds.
pp_check(model_simple_brain_Cichlidae)summary(model_simple_brain_Cichlidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Cichlidae (Number of observations: 104)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.19 0.27 0.00 0.85 1.00
sd(log10_body_size) 0.17 0.22 0.00 0.79 1.00
cor(Intercept,log10_body_size) -0.07 0.63 -0.98 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 1615 2415
sd(log10_body_size) 1567 2037
cor(Intercept,log10_body_size) 3587 4161
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.69 0.20 -2.07 -1.22 1.00 2598 2557
log10_body_size 0.58 0.16 0.29 0.97 1.00 1518 1502
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.10 0.01 0.08 0.11 1.00 5965 5418
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Cichlidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Cichlidae)$sex)[[1]],
slope = coef(model_simple_brain_Cichlidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Cichlidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Cichlidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Cichlidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.70 -1.76 -1.64 0.561 0.508 0.612
2 male -1.71 -1.77 -1.64 0.560 0.505 0.613
model_phylo_brain_Cichlidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Cichlidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 3 finished in 78.4 seconds.
Chain 4 finished in 80.0 seconds.
Chain 2 finished in 104.5 seconds.
Chain 1 finished in 131.6 seconds.
All 4 chains finished successfully.
Mean chain execution time: 98.6 seconds.
Total execution time: 131.7 seconds.
pp_check(model_phylo_brain_Cichlidae)summary(model_phylo_brain_Cichlidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Cichlidae (Number of observations: 104)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 52)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.12 0.01 0.09 0.15 1.00 1324 2282
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.17 0.23 0.00 0.82 1.00
sd(log10_body_size) 0.13 0.20 0.00 0.67 1.00
cor(Intercept,log10_body_size) -0.04 0.63 -0.98 0.97 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2103 3504
sd(log10_body_size) 1854 3550
cor(Intercept,log10_body_size) 5275 4667
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.57 0.19 -1.95 -1.16 1.00 2008 2414
log10_body_size 0.45 0.12 0.22 0.79 1.00 1958 1836
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.03 0.00 0.02 0.04 1.00 2126 3797
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Cichlidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.57 0.33 0.02 0.96 0.2
Post.Prob Star
1 0.17 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Cichlidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Cichlidae)$sex)[[1]],
slope = coef(model_phylo_brain_Cichlidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Cichlidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Cichlidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Cichlidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.58 -1.69 -1.47 0.430 0.383 0.479
2 male -1.57 -1.69 -1.46 0.424 0.375 0.474
loo_simple <- loo(model_simple_brain_Cichlidae)
loo_phylo <- loo(model_phylo_brain_Cichlidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Cichlidae 0.0 0.0
model_simple_brain_Cichlidae -90.6 14.5
# Filter full data to those families only
dat_organ_Syngnathidae <- dat_brain_all %>%
filter(family == "Syngnathidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Syngnathidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Anguilla_anguilla" "Syncerus_caffer"
[57] "Tragelaphus_eurycerus" "Tragelaphus_scriptus"
[59] "Redunca_arundinum" "Antidorcas_marsupialis"
[61] "Nanger_granti" "Raphicerus_campestris"
[63] "Cephalophus_natalensis" "Sylvicapra_grimmia"
[65] "Oreotragus_oreotragus" "Hippotragus_equinus"
[67] "Addax_nasomaculatus" "Oryx_gazella"
[69] "Connochaetes_taurinus" "Damaliscus_lunatus"
[71] "Ovis_aries" "Aepyceros_melampus"
[73] "Pteropus_alecto" "Pteropus_poliocephalus"
[75] "Pteropus_scapulatus" "Lasiopodomys_brandtii"
[77] "Rattus_norvegicus" "Mus_musculus"
[79] "Meriones_unguiculatus" "Chlorocebus_aethiops"
[81] "Chlorocebus_sabaeus" "Erythrocebus_patas"
[83] "Papio_cynocephalus" "Papio_anubis"
[85] "Cercocebus_atys" "Macaca_arctoides"
[87] "Macaca_mulatta" "Macaca_fascicularis"
[89] "Macaca_maura" "Trachypithecus_francoisi"
[91] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[93] "Platycercus_elegans" "Platycercus_eximius"
[95] "Platycercus_venustus" "Barnardius_zonarius"
[97] "Northiella_haematogaster" "Lathamus_discolor"
[99] "Neophema_chrysostoma" "Neophema_pulchella"
[101] "Psittacula_krameri" "Eclectus_roratus"
[103] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[105] "Alisterus_amboinensis" "Polytelis_alexandrae"
[107] "Trichoglossus_haematodus" "Agapornis_lilianae"
[109] "Agapornis_taranta" "Loriculus_vernalis"
[111] "Ara_ararauna" "Guaruba_guarouba"
[113] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[115] "Forpus_coelestis" "Forpus_passerinus"
[117] "Amazona_leucocephala" "Amazona_albifrons"
[119] "Amazona_pretrei" "Amazona_vinacea"
[121] "Amazona_finschi" "Amazona_amazonica"
[123] "Amazona_ochrocephala" "Amazona_aestiva"
[125] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[127] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[129] "Poicephalus_meyeri" "Psittacus_erithacus"
[131] "Serinus_mennelli" "Ficedula_hypoleuca"
[133] "Padda_oryzivora" "Lonchura_punctulata"
[135] "Lonchura_flaviprymna" "Lonchura_bicolor"
[137] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[139] "Uraeginthus_bengalus" "Amandava_amandava"
[141] "Plectrophenax_nivalis" "Serinus_canaria"
[143] "Serinus_serinus" "Loxia_curvirostra"
[145] "Carduelis_carduelis" "Carpodacus_roseus"
[147] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[149] "Pinicola_enucleator" "Bucanetes_githagineus"
[151] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[153] "Mycerobas_carnipes" "Fringilla_montifringilla"
[155] "Fringilla_coelebs" "Anas_platyrhynchos"
[157] "Anas_acuta" "Anas_crecca"
[159] "Mergus_serrator" "Mergus_merganser"
[161] "Bucephala_clangula" "Melanitta_nigra"
[163] "Somateria_mollissima" "Callonetta_leucophrys"
[165] "Branta_bernicla" "Branta_leucopsis"
[167] "Anser_anser" "Cygnus_columbianus"
[169] "Tadorna_tadorna" "Coturnix_japonica"
[171] "Pucrasia_macrolopha" "Phasianus_colchicus"
[173] "Chrysolophus_pictus" "Lophura_nycthemera"
[175] "Lophura_ignita" "Syrmaticus_ellioti"
[177] "Syrmaticus_reevesii" "Perdix_perdix"
[179] "Tetrao_urogallus" "Lagopus_muta"
[181] "Lagopus_lagopus" "Lophophorus_impejanus"
[183] "Tragopan_temminckii" "Pavo_cristatus"
[185] "Gallus_gallus" "Gallus_sonneratii"
[187] "Rollulus_rouloul" "Arborophila_torqueola"
[189] "Numida_meleagris"
setdiff(dat_organ_Syngnathidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Syngnathidae$phylo))
dat_organ_Syngnathidae <- dat_organ_Syngnathidae[dat_organ_Syngnathidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Syngnathidae$phylo)character(0)
setdiff(dat_organ_Syngnathidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 15
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Syngnathidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Syngnathidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 2.1 seconds.
Chain 2 finished in 2.0 seconds.
Chain 4 finished in 1.9 seconds.
Chain 3 finished in 2.1 seconds.
All 4 chains finished successfully.
Mean chain execution time: 2.0 seconds.
Total execution time: 2.2 seconds.
pp_check(model_simple_brain_Syngnathidae)summary(model_simple_brain_Syngnathidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Syngnathidae (Number of observations: 30)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.22 0.25 0.00 0.93 1.00
sd(log10_body_size) 0.21 0.23 0.00 0.87 1.00
cor(Intercept,log10_body_size) -0.03 0.60 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2281 2624
sd(log10_body_size) 2415 3420
cor(Intercept,log10_body_size) 4795 4767
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.36 0.21 -2.76 -1.81 1.00 2167 1947
log10_body_size 0.56 0.17 0.23 0.98 1.00 2438 2271
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.17 0.02 0.13 0.22 1.00 6741 4508
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Syngnathidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Syngnathidae)$sex)[[1]],
slope = coef(model_simple_brain_Syngnathidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Syngnathidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Syngnathidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Syngnathidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.37 -2.46 -2.28 0.524 0.399 0.645
2 male -2.40 -2.50 -2.31 0.535 0.411 0.667
model_phylo_brain_Syngnathidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Syngnathidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 3 finished in 7.8 seconds.
Chain 4 finished in 7.9 seconds.
Chain 1 finished in 13.6 seconds.
Chain 2 finished in 14.7 seconds.
All 4 chains finished successfully.
Mean chain execution time: 11.0 seconds.
Total execution time: 14.9 seconds.
pp_check(model_phylo_brain_Syngnathidae)summary(model_phylo_brain_Syngnathidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Syngnathidae (Number of observations: 30)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 15)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.22 0.06 0.13 0.35 1.00 1694 3070
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.22 0.27 0.01 0.91 1.00
sd(log10_body_size) 0.18 0.23 0.00 0.78 1.00
cor(Intercept,log10_body_size) -0.05 0.62 -0.98 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2303 3289
sd(log10_body_size) 2967 4403
cor(Intercept,log10_body_size) 5672 4883
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -2.36 0.25 -2.80 -1.80 1.00 2437 1657
log10_body_size 0.55 0.17 0.25 0.98 1.00 2851 3020
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.07 0.02 0.05 0.12 1.00 1913 3164
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Syngnathidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.59 0.29 0.04 0.95 0.1
Post.Prob Star
1 0.09 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Syngnathidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Syngnathidae)$sex)[[1]],
slope = coef(model_phylo_brain_Syngnathidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Syngnathidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Syngnathidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Syngnathidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -2.36 -2.57 -2.16 0.517 0.349 0.681
2 male -2.40 -2.61 -2.20 0.535 0.358 0.706
loo_simple <- loo(model_simple_brain_Syngnathidae)
loo_phylo <- loo(model_phylo_brain_Syngnathidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Syngnathidae 0.0 0.0
model_simple_brain_Syngnathidae -17.2 3.6
# Filter full data to those families only
dat_organ_Psittacidae <- dat_brain_all %>%
filter(family == "Psittacidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Psittacidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[93] "Mus_musculus" "Meriones_unguiculatus"
[95] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[97] "Erythrocebus_patas" "Papio_cynocephalus"
[99] "Papio_anubis" "Cercocebus_atys"
[101] "Macaca_arctoides" "Macaca_mulatta"
[103] "Macaca_fascicularis" "Macaca_maura"
[105] "Trachypithecus_francoisi" "Phrynocephalus_vlangalii"
[107] "Serinus_mennelli" "Ficedula_hypoleuca"
[109] "Padda_oryzivora" "Lonchura_punctulata"
[111] "Lonchura_flaviprymna" "Lonchura_bicolor"
[113] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[115] "Uraeginthus_bengalus" "Amandava_amandava"
[117] "Plectrophenax_nivalis" "Serinus_canaria"
[119] "Serinus_serinus" "Loxia_curvirostra"
[121] "Carduelis_carduelis" "Carpodacus_roseus"
[123] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[125] "Pinicola_enucleator" "Bucanetes_githagineus"
[127] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[129] "Mycerobas_carnipes" "Fringilla_montifringilla"
[131] "Fringilla_coelebs" "Anas_platyrhynchos"
[133] "Anas_acuta" "Anas_crecca"
[135] "Mergus_serrator" "Mergus_merganser"
[137] "Bucephala_clangula" "Melanitta_nigra"
[139] "Somateria_mollissima" "Callonetta_leucophrys"
[141] "Branta_bernicla" "Branta_leucopsis"
[143] "Anser_anser" "Cygnus_columbianus"
[145] "Tadorna_tadorna" "Coturnix_japonica"
[147] "Pucrasia_macrolopha" "Phasianus_colchicus"
[149] "Chrysolophus_pictus" "Lophura_nycthemera"
[151] "Lophura_ignita" "Syrmaticus_ellioti"
[153] "Syrmaticus_reevesii" "Perdix_perdix"
[155] "Tetrao_urogallus" "Lagopus_muta"
[157] "Lagopus_lagopus" "Lophophorus_impejanus"
[159] "Tragopan_temminckii" "Pavo_cristatus"
[161] "Gallus_gallus" "Gallus_sonneratii"
[163] "Rollulus_rouloul" "Arborophila_torqueola"
[165] "Numida_meleagris"
setdiff(dat_organ_Psittacidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Psittacidae$phylo))
dat_organ_Psittacidae <- dat_organ_Psittacidae[dat_organ_Psittacidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Psittacidae$phylo)character(0)
setdiff(dat_organ_Psittacidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 39
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Psittacidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Psittacidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 11.8 seconds.
Chain 3 finished in 12.3 seconds.
Chain 1 finished in 14.2 seconds.
Chain 4 finished in 16.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 13.6 seconds.
Total execution time: 16.2 seconds.
pp_check(model_simple_brain_Psittacidae)summary(model_simple_brain_Psittacidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Psittacidae (Number of observations: 78)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.25 0.29 0.01 1.02 1.00
sd(log10_body_size) 0.16 0.21 0.00 0.73 1.00
cor(Intercept,log10_body_size) -0.07 0.60 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2426 2586
sd(log10_body_size) 1635 2788
cor(Intercept,log10_body_size) 4156 4416
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.02 0.24 -1.58 -0.55 1.00 3282 3235
log10_body_size 0.75 0.13 0.44 1.02 1.00 2279 1869
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.09 0.01 0.07 0.10 1.00 5679 4619
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Psittacidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Psittacidae)$sex)[[1]],
slope = coef(model_simple_brain_Psittacidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Psittacidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Psittacidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Psittacidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -1.04 -1.18 -0.914 0.765 0.705 0.832
2 male -0.987 -1.12 -0.850 0.754 0.689 0.815
model_phylo_brain_Psittacidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Psittacidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 36.9 seconds.
Chain 1 finished in 41.7 seconds.
Chain 3 finished in 44.2 seconds.
Chain 4 finished in 51.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 43.4 seconds.
Total execution time: 51.2 seconds.
pp_check(model_phylo_brain_Psittacidae)summary(model_phylo_brain_Psittacidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Psittacidae (Number of observations: 78)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 39)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.08 0.02 0.05 0.13 1.00 975 1421
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.26 0.29 0.01 0.99 1.00
sd(log10_body_size) 0.16 0.20 0.00 0.73 1.01
cor(Intercept,log10_body_size) -0.09 0.60 -0.97 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3149 3449
sd(log10_body_size) 2070 3355
cor(Intercept,log10_body_size) 5718 5344
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.82 0.27 -1.39 -0.27 1.00 2427 3635
log10_body_size 0.67 0.14 0.37 0.99 1.00 1825 2288
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.05 0.01 0.04 0.07 1.00 1168 2423
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Psittacidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.24 0.23 0.01 0.76 0.75
Post.Prob Star
1 0.43 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Psittacidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Psittacidae)$sex)[[1]],
slope = coef(model_phylo_brain_Psittacidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Psittacidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Psittacidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Psittacidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.849 -1.05 -0.586 0.675 0.546 0.774
2 male -0.778 -0.981 -0.518 0.658 0.532 0.756
loo_simple <- loo(model_simple_brain_Psittacidae)
loo_phylo <- loo(model_phylo_brain_Psittacidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Psittacidae 0.0 0.0
model_simple_brain_Psittacidae -24.0 5.7
# Filter full data to those families only
dat_organ_Fringillidae <- dat_brain_all %>%
filter(family == "Fringillidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Fringillidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[93] "Mus_musculus" "Meriones_unguiculatus"
[95] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[97] "Erythrocebus_patas" "Papio_cynocephalus"
[99] "Papio_anubis" "Cercocebus_atys"
[101] "Macaca_arctoides" "Macaca_mulatta"
[103] "Macaca_fascicularis" "Macaca_maura"
[105] "Trachypithecus_francoisi" "Phrynocephalus_vlangalii"
[107] "Platycercus_caledonicus" "Platycercus_elegans"
[109] "Platycercus_eximius" "Platycercus_venustus"
[111] "Barnardius_zonarius" "Northiella_haematogaster"
[113] "Lathamus_discolor" "Neophema_chrysostoma"
[115] "Neophema_pulchella" "Psittacula_krameri"
[117] "Eclectus_roratus" "Aprosmictus_jonquillaceus"
[119] "Alisterus_scapularis" "Alisterus_amboinensis"
[121] "Polytelis_alexandrae" "Trichoglossus_haematodus"
[123] "Agapornis_lilianae" "Agapornis_taranta"
[125] "Loriculus_vernalis" "Ara_ararauna"
[127] "Guaruba_guarouba" "Enicognathus_leptorhynchus"
[129] "Pionites_melanocephalus" "Forpus_coelestis"
[131] "Forpus_passerinus" "Amazona_leucocephala"
[133] "Amazona_albifrons" "Amazona_pretrei"
[135] "Amazona_vinacea" "Amazona_finschi"
[137] "Amazona_amazonica" "Amazona_ochrocephala"
[139] "Amazona_aestiva" "Brotogeris_versicolurus"
[141] "Brotogeris_pyrrhoptera" "Bolborhynchus_lineola"
[143] "Poicephalus_gulielmi" "Poicephalus_meyeri"
[145] "Psittacus_erithacus" "Ficedula_hypoleuca"
[147] "Padda_oryzivora" "Lonchura_punctulata"
[149] "Lonchura_flaviprymna" "Lonchura_bicolor"
[151] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[153] "Uraeginthus_bengalus" "Amandava_amandava"
[155] "Anas_platyrhynchos" "Anas_acuta"
[157] "Anas_crecca" "Mergus_serrator"
[159] "Mergus_merganser" "Bucephala_clangula"
[161] "Melanitta_nigra" "Somateria_mollissima"
[163] "Callonetta_leucophrys" "Branta_bernicla"
[165] "Branta_leucopsis" "Anser_anser"
[167] "Cygnus_columbianus" "Tadorna_tadorna"
[169] "Coturnix_japonica" "Pucrasia_macrolopha"
[171] "Phasianus_colchicus" "Chrysolophus_pictus"
[173] "Lophura_nycthemera" "Lophura_ignita"
[175] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[177] "Perdix_perdix" "Tetrao_urogallus"
[179] "Lagopus_muta" "Lagopus_lagopus"
[181] "Lophophorus_impejanus" "Tragopan_temminckii"
[183] "Pavo_cristatus" "Gallus_gallus"
[185] "Gallus_sonneratii" "Rollulus_rouloul"
[187] "Arborophila_torqueola" "Numida_meleagris"
setdiff(dat_organ_Fringillidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Fringillidae$phylo))
dat_organ_Fringillidae <- dat_organ_Fringillidae[dat_organ_Fringillidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Fringillidae$phylo)character(0)
setdiff(dat_organ_Fringillidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 16
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Fringillidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Fringillidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 5.3 seconds.
Chain 3 finished in 6.5 seconds.
Chain 4 finished in 7.9 seconds.
Chain 2 finished in 9.1 seconds.
All 4 chains finished successfully.
Mean chain execution time: 7.2 seconds.
Total execution time: 9.3 seconds.
pp_check(model_simple_brain_Fringillidae)summary(model_simple_brain_Fringillidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Fringillidae (Number of observations: 32)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.26 0.28 0.01 0.98 1.00
sd(log10_body_size) 0.19 0.21 0.00 0.76 1.00
cor(Intercept,log10_body_size) -0.09 0.59 -0.97 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2893 3228
sd(log10_body_size) 2216 3123
cor(Intercept,log10_body_size) 4179 4574
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.02 0.25 -1.57 -0.53 1.00 3116 3015
log10_body_size 0.71 0.16 0.37 1.05 1.00 3143 2831
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.09 0.01 0.07 0.12 1.00 5533 4254
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Fringillidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Fringillidae)$sex)[[1]],
slope = coef(model_simple_brain_Fringillidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Fringillidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Fringillidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Fringillidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.989 -1.19 -0.779 0.693 0.541 0.840
2 male -1.04 -1.28 -0.825 0.714 0.560 0.881
model_phylo_brain_Fringillidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Fringillidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 3 finished in 11.1 seconds.
Chain 1 finished in 11.3 seconds.
Chain 4 finished in 11.3 seconds.
Chain 2 finished in 17.1 seconds.
All 4 chains finished successfully.
Mean chain execution time: 12.7 seconds.
Total execution time: 17.3 seconds.
pp_check(model_phylo_brain_Fringillidae)summary(model_phylo_brain_Fringillidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Fringillidae (Number of observations: 32)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 16)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.08 0.03 0.02 0.16 1.00 1758 1740
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.24 0.28 0.01 1.01 1.00
sd(log10_body_size) 0.18 0.21 0.00 0.76 1.00
cor(Intercept,log10_body_size) -0.09 0.61 -0.98 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2809 3504
sd(log10_body_size) 2425 4071
cor(Intercept,log10_body_size) 5171 5233
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -1.00 0.28 -1.55 -0.44 1.00 3009 2537
log10_body_size 0.69 0.17 0.35 1.07 1.00 2554 1871
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.06 0.01 0.04 0.09 1.00 2083 4261
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Fringillidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.26 0.25 0 0.81 0.76
Post.Prob Star
1 0.43 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Fringillidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Fringillidae)$sex)[[1]],
slope = coef(model_phylo_brain_Fringillidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Fringillidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Fringillidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Fringillidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.982 -1.24 -0.696 0.679 0.481 0.858
2 male -1.03 -1.31 -0.726 0.692 0.489 0.882
loo_simple <- loo(model_simple_brain_Fringillidae)
loo_phylo <- loo(model_phylo_brain_Fringillidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Fringillidae 0.0 0.0
model_simple_brain_Fringillidae -3.8 2.9
# Filter full data to those families only
dat_organ_Phasianidae <- dat_brain_all %>%
filter(family == "Phasianidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Phasianidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[93] "Mus_musculus" "Meriones_unguiculatus"
[95] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[97] "Erythrocebus_patas" "Papio_cynocephalus"
[99] "Papio_anubis" "Cercocebus_atys"
[101] "Macaca_arctoides" "Macaca_mulatta"
[103] "Macaca_fascicularis" "Macaca_maura"
[105] "Trachypithecus_francoisi" "Phrynocephalus_vlangalii"
[107] "Platycercus_caledonicus" "Platycercus_elegans"
[109] "Platycercus_eximius" "Platycercus_venustus"
[111] "Barnardius_zonarius" "Northiella_haematogaster"
[113] "Lathamus_discolor" "Neophema_chrysostoma"
[115] "Neophema_pulchella" "Psittacula_krameri"
[117] "Eclectus_roratus" "Aprosmictus_jonquillaceus"
[119] "Alisterus_scapularis" "Alisterus_amboinensis"
[121] "Polytelis_alexandrae" "Trichoglossus_haematodus"
[123] "Agapornis_lilianae" "Agapornis_taranta"
[125] "Loriculus_vernalis" "Ara_ararauna"
[127] "Guaruba_guarouba" "Enicognathus_leptorhynchus"
[129] "Pionites_melanocephalus" "Forpus_coelestis"
[131] "Forpus_passerinus" "Amazona_leucocephala"
[133] "Amazona_albifrons" "Amazona_pretrei"
[135] "Amazona_vinacea" "Amazona_finschi"
[137] "Amazona_amazonica" "Amazona_ochrocephala"
[139] "Amazona_aestiva" "Brotogeris_versicolurus"
[141] "Brotogeris_pyrrhoptera" "Bolborhynchus_lineola"
[143] "Poicephalus_gulielmi" "Poicephalus_meyeri"
[145] "Psittacus_erithacus" "Serinus_mennelli"
[147] "Ficedula_hypoleuca" "Padda_oryzivora"
[149] "Lonchura_punctulata" "Lonchura_flaviprymna"
[151] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[153] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[155] "Amandava_amandava" "Plectrophenax_nivalis"
[157] "Serinus_canaria" "Serinus_serinus"
[159] "Loxia_curvirostra" "Carduelis_carduelis"
[161] "Carpodacus_roseus" "Uragus_sibiricus"
[163] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[165] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[167] "Mycerobas_affinis" "Mycerobas_carnipes"
[169] "Fringilla_montifringilla" "Fringilla_coelebs"
[171] "Anas_platyrhynchos" "Anas_acuta"
[173] "Anas_crecca" "Mergus_serrator"
[175] "Mergus_merganser" "Bucephala_clangula"
[177] "Melanitta_nigra" "Somateria_mollissima"
[179] "Callonetta_leucophrys" "Branta_bernicla"
[181] "Branta_leucopsis" "Anser_anser"
[183] "Cygnus_columbianus" "Tadorna_tadorna"
[185] "Coturnix_japonica" "Gallus_gallus"
[187] "Numida_meleagris"
setdiff(dat_organ_Phasianidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Phasianidae$phylo))
dat_organ_Phasianidae <- dat_organ_Phasianidae[dat_organ_Phasianidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Phasianidae$phylo)character(0)
setdiff(dat_organ_Phasianidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 17
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Phasianidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Phasianidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 9.5 seconds.
Chain 3 finished in 11.3 seconds.
Chain 2 finished in 11.6 seconds.
Chain 4 finished in 14.2 seconds.
All 4 chains finished successfully.
Mean chain execution time: 11.6 seconds.
Total execution time: 14.3 seconds.
pp_check(model_simple_brain_Phasianidae)summary(model_simple_brain_Phasianidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Phasianidae (Number of observations: 34)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.26 0.30 0.01 1.05 1.00
sd(log10_body_size) 0.16 0.20 0.00 0.73 1.00
cor(Intercept,log10_body_size) -0.08 0.61 -0.98 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2634 2705
sd(log10_body_size) 1380 2732
cor(Intercept,log10_body_size) 4069 3772
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.87 0.30 -1.42 -0.36 1.00 3307 3275
log10_body_size 0.49 0.14 0.24 0.82 1.00 1739 1149
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.07 0.01 0.05 0.09 1.00 6267 5113
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Phasianidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Phasianidae)$sex)[[1]],
slope = coef(model_simple_brain_Phasianidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Phasianidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Phasianidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Phasianidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.863 -1.10 -0.628 0.480 0.396 0.563
2 male -0.854 -1.08 -0.627 0.475 0.399 0.550
model_phylo_brain_Phasianidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Phasianidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 22.5 seconds.
Chain 2 finished in 28.3 seconds.
Chain 1 finished in 32.4 seconds.
Chain 3 finished in 38.0 seconds.
All 4 chains finished successfully.
Mean chain execution time: 30.3 seconds.
Total execution time: 38.2 seconds.
pp_check(model_phylo_brain_Phasianidae)summary(model_phylo_brain_Phasianidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Phasianidae (Number of observations: 34)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 17)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.07 0.02 0.04 0.12 1.00 1548 2328
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.23 0.29 0.00 1.00 1.00
sd(log10_body_size) 0.13 0.18 0.00 0.62 1.00
cor(Intercept,log10_body_size) -0.09 0.62 -0.98 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2912 3607
sd(log10_body_size) 1323 3346
cor(Intercept,log10_body_size) 4308 4832
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.76 0.28 -1.35 -0.23 1.00 3345 4036
log10_body_size 0.45 0.12 0.21 0.73 1.00 2109 1973
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.04 0.01 0.03 0.06 1.00 1979 3341
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Phasianidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.3 0.28 0 0.86 0.68
Post.Prob Star
1 0.4 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Phasianidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Phasianidae)$sex)[[1]],
slope = coef(model_phylo_brain_Phasianidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Phasianidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Phasianidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Phasianidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.756 -1.05 -0.436 0.443 0.332 0.546
2 male -0.732 -1.01 -0.424 0.435 0.333 0.527
loo_simple <- loo(model_simple_brain_Phasianidae)
loo_phylo <- loo(model_phylo_brain_Phasianidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Phasianidae 0.0 0.0
model_simple_brain_Phasianidae -11.6 3.6
# Filter full data to those families only
dat_organ_Anatidae <- dat_brain_all %>%
filter(family == "Anatidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Anatidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[93] "Mus_musculus" "Meriones_unguiculatus"
[95] "Chlorocebus_aethiops" "Chlorocebus_sabaeus"
[97] "Erythrocebus_patas" "Papio_cynocephalus"
[99] "Papio_anubis" "Cercocebus_atys"
[101] "Macaca_arctoides" "Macaca_mulatta"
[103] "Macaca_fascicularis" "Macaca_maura"
[105] "Trachypithecus_francoisi" "Phrynocephalus_vlangalii"
[107] "Platycercus_caledonicus" "Platycercus_elegans"
[109] "Platycercus_eximius" "Platycercus_venustus"
[111] "Barnardius_zonarius" "Northiella_haematogaster"
[113] "Lathamus_discolor" "Neophema_chrysostoma"
[115] "Neophema_pulchella" "Psittacula_krameri"
[117] "Eclectus_roratus" "Aprosmictus_jonquillaceus"
[119] "Alisterus_scapularis" "Alisterus_amboinensis"
[121] "Polytelis_alexandrae" "Trichoglossus_haematodus"
[123] "Agapornis_lilianae" "Agapornis_taranta"
[125] "Loriculus_vernalis" "Ara_ararauna"
[127] "Guaruba_guarouba" "Enicognathus_leptorhynchus"
[129] "Pionites_melanocephalus" "Forpus_coelestis"
[131] "Forpus_passerinus" "Amazona_leucocephala"
[133] "Amazona_albifrons" "Amazona_pretrei"
[135] "Amazona_vinacea" "Amazona_finschi"
[137] "Amazona_amazonica" "Amazona_ochrocephala"
[139] "Amazona_aestiva" "Brotogeris_versicolurus"
[141] "Brotogeris_pyrrhoptera" "Bolborhynchus_lineola"
[143] "Poicephalus_gulielmi" "Poicephalus_meyeri"
[145] "Psittacus_erithacus" "Serinus_mennelli"
[147] "Ficedula_hypoleuca" "Padda_oryzivora"
[149] "Lonchura_punctulata" "Lonchura_flaviprymna"
[151] "Lonchura_bicolor" "Hypargos_niveoguttatus"
[153] "Pytilia_hypogrammica" "Uraeginthus_bengalus"
[155] "Amandava_amandava" "Plectrophenax_nivalis"
[157] "Serinus_canaria" "Serinus_serinus"
[159] "Loxia_curvirostra" "Carduelis_carduelis"
[161] "Carpodacus_roseus" "Uragus_sibiricus"
[163] "Pyrrhula_pyrrhula" "Pinicola_enucleator"
[165] "Bucanetes_githagineus" "Coccothraustes_coccothraustes"
[167] "Mycerobas_affinis" "Mycerobas_carnipes"
[169] "Fringilla_montifringilla" "Fringilla_coelebs"
[171] "Coturnix_japonica" "Pucrasia_macrolopha"
[173] "Phasianus_colchicus" "Chrysolophus_pictus"
[175] "Lophura_nycthemera" "Lophura_ignita"
[177] "Syrmaticus_ellioti" "Syrmaticus_reevesii"
[179] "Perdix_perdix" "Tetrao_urogallus"
[181] "Lagopus_muta" "Lagopus_lagopus"
[183] "Lophophorus_impejanus" "Tragopan_temminckii"
[185] "Pavo_cristatus" "Gallus_gallus"
[187] "Gallus_sonneratii" "Rollulus_rouloul"
[189] "Arborophila_torqueola" "Numida_meleagris"
setdiff(dat_organ_Anatidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Anatidae$phylo))
dat_organ_Anatidae <- dat_organ_Anatidae[dat_organ_Anatidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Anatidae$phylo)character(0)
setdiff(dat_organ_Anatidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 14
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Anatidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Anatidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 3 finished in 9.2 seconds.
Chain 2 finished in 9.8 seconds.
Chain 4 finished in 11.8 seconds.
Chain 1 finished in 26.6 seconds.
All 4 chains finished successfully.
Mean chain execution time: 14.4 seconds.
Total execution time: 26.7 seconds.
pp_check(model_simple_brain_Anatidae)summary(model_simple_brain_Anatidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Anatidae (Number of observations: 28)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.28 0.29 0.01 1.06 1.00
sd(log10_body_size) 0.16 0.19 0.00 0.68 1.00
cor(Intercept,log10_body_size) -0.11 0.60 -0.98 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2948 3623
sd(log10_body_size) 1546 3336
cor(Intercept,log10_body_size) 4455 4715
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.85 0.28 -1.45 -0.29 1.00 3270 3706
log10_body_size 0.53 0.13 0.23 0.83 1.00 1776 1724
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.07 0.01 0.05 0.09 1.00 5083 4416
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Anatidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Anatidae)$sex)[[1]],
slope = coef(model_simple_brain_Anatidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Anatidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Anatidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Anatidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.809 -1.05 -0.566 0.523 0.443 0.601
2 male -0.879 -1.15 -0.623 0.536 0.455 0.624
model_phylo_brain_Anatidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Anatidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 19.0 seconds.
Chain 4 finished in 19.6 seconds.
Chain 3 finished in 26.0 seconds.
Chain 2 finished in 56.2 seconds.
All 4 chains finished successfully.
Mean chain execution time: 30.2 seconds.
Total execution time: 56.3 seconds.
pp_check(model_phylo_brain_Anatidae)summary(model_phylo_brain_Anatidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Anatidae (Number of observations: 28)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 14)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.07 0.04 0.01 0.17 1.00 911 1547
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.28 0.32 0.01 1.08 1.00
sd(log10_body_size) 0.15 0.19 0.00 0.69 1.00
cor(Intercept,log10_body_size) -0.10 0.60 -0.97 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2623 3191
sd(log10_body_size) 2075 3836
cor(Intercept,log10_body_size) 5880 5151
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.64 0.37 -1.33 0.15 1.00 1501 1722
log10_body_size 0.47 0.14 0.18 0.77 1.00 1631 2213
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.05 0.01 0.03 0.08 1.00 1027 1497
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Anatidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.21 0.25 0 0.87 1.2
Post.Prob Star
1 0.56 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Anatidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Anatidae)$sex)[[1]],
slope = coef(model_phylo_brain_Anatidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Anatidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Anatidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Anatidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.591 -0.985 0.0562 0.453 0.248 0.580
2 male -0.661 -1.09 0.0292 0.467 0.253 0.604
loo_simple <- loo(model_simple_brain_Anatidae)
loo_phylo <- loo(model_phylo_brain_Anatidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Anatidae 0.0 0.0
model_simple_brain_Anatidae -1.4 2.7
# Filter full data to those families only
dat_organ_Cercopithecidae <- dat_brain_all %>%
filter(family == "Cercopithecidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Cercopithecidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Syncerus_caffer" "Tragelaphus_eurycerus"
[73] "Tragelaphus_scriptus" "Redunca_arundinum"
[75] "Antidorcas_marsupialis" "Nanger_granti"
[77] "Raphicerus_campestris" "Cephalophus_natalensis"
[79] "Sylvicapra_grimmia" "Oreotragus_oreotragus"
[81] "Hippotragus_equinus" "Addax_nasomaculatus"
[83] "Oryx_gazella" "Connochaetes_taurinus"
[85] "Damaliscus_lunatus" "Ovis_aries"
[87] "Aepyceros_melampus" "Pteropus_alecto"
[89] "Pteropus_poliocephalus" "Pteropus_scapulatus"
[91] "Lasiopodomys_brandtii" "Rattus_norvegicus"
[93] "Mus_musculus" "Meriones_unguiculatus"
[95] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[97] "Platycercus_elegans" "Platycercus_eximius"
[99] "Platycercus_venustus" "Barnardius_zonarius"
[101] "Northiella_haematogaster" "Lathamus_discolor"
[103] "Neophema_chrysostoma" "Neophema_pulchella"
[105] "Psittacula_krameri" "Eclectus_roratus"
[107] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[109] "Alisterus_amboinensis" "Polytelis_alexandrae"
[111] "Trichoglossus_haematodus" "Agapornis_lilianae"
[113] "Agapornis_taranta" "Loriculus_vernalis"
[115] "Ara_ararauna" "Guaruba_guarouba"
[117] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[119] "Forpus_coelestis" "Forpus_passerinus"
[121] "Amazona_leucocephala" "Amazona_albifrons"
[123] "Amazona_pretrei" "Amazona_vinacea"
[125] "Amazona_finschi" "Amazona_amazonica"
[127] "Amazona_ochrocephala" "Amazona_aestiva"
[129] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[131] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[133] "Poicephalus_meyeri" "Psittacus_erithacus"
[135] "Serinus_mennelli" "Ficedula_hypoleuca"
[137] "Padda_oryzivora" "Lonchura_punctulata"
[139] "Lonchura_flaviprymna" "Lonchura_bicolor"
[141] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[143] "Uraeginthus_bengalus" "Amandava_amandava"
[145] "Plectrophenax_nivalis" "Serinus_canaria"
[147] "Serinus_serinus" "Loxia_curvirostra"
[149] "Carduelis_carduelis" "Carpodacus_roseus"
[151] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[153] "Pinicola_enucleator" "Bucanetes_githagineus"
[155] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[157] "Mycerobas_carnipes" "Fringilla_montifringilla"
[159] "Fringilla_coelebs" "Anas_platyrhynchos"
[161] "Anas_acuta" "Anas_crecca"
[163] "Mergus_serrator" "Mergus_merganser"
[165] "Bucephala_clangula" "Melanitta_nigra"
[167] "Somateria_mollissima" "Callonetta_leucophrys"
[169] "Branta_bernicla" "Branta_leucopsis"
[171] "Anser_anser" "Cygnus_columbianus"
[173] "Tadorna_tadorna" "Coturnix_japonica"
[175] "Pucrasia_macrolopha" "Phasianus_colchicus"
[177] "Chrysolophus_pictus" "Lophura_nycthemera"
[179] "Lophura_ignita" "Syrmaticus_ellioti"
[181] "Syrmaticus_reevesii" "Perdix_perdix"
[183] "Tetrao_urogallus" "Lagopus_muta"
[185] "Lagopus_lagopus" "Lophophorus_impejanus"
[187] "Tragopan_temminckii" "Pavo_cristatus"
[189] "Gallus_gallus" "Gallus_sonneratii"
[191] "Rollulus_rouloul" "Arborophila_torqueola"
[193] "Numida_meleagris"
setdiff(dat_organ_Cercopithecidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Cercopithecidae$phylo))
dat_organ_Cercopithecidae <- dat_organ_Cercopithecidae[dat_organ_Cercopithecidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Cercopithecidae$phylo)character(0)
setdiff(dat_organ_Cercopithecidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 11
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Cercopithecidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Cercopithecidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 5.8 seconds.
Chain 2 finished in 6.5 seconds.
Chain 3 finished in 6.6 seconds.
Chain 1 finished in 7.1 seconds.
All 4 chains finished successfully.
Mean chain execution time: 6.5 seconds.
Total execution time: 7.2 seconds.
pp_check(model_simple_brain_Cercopithecidae)summary(model_simple_brain_Cercopithecidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Cercopithecidae (Number of observations: 22)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.34 0.36 0.01 1.27 1.00
sd(log10_body_size) 0.17 0.19 0.00 0.70 1.00
cor(Intercept,log10_body_size) -0.13 0.59 -0.98 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2810 3337
sd(log10_body_size) 1672 2989
cor(Intercept,log10_body_size) 3602 4349
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept 0.14 0.60 -1.11 1.30 1.00 5934 4770
log10_body_size 0.48 0.18 0.10 0.84 1.00 3474 3151
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.12 0.02 0.09 0.18 1.00 5974 4533
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Cercopithecidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Cercopithecidae)$sex)[[1]],
slope = coef(model_simple_brain_Cercopithecidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Cercopithecidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Cercopithecidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Cercopithecidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female 0.173 -0.910 1.20 0.486 0.210 0.780
2 male 0.168 -0.900 1.19 0.482 0.213 0.763
model_phylo_brain_Cercopithecidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Cercopithecidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 4 finished in 47.3 seconds.
Chain 2 finished in 53.6 seconds.
Chain 3 finished in 53.9 seconds.
Chain 1 finished in 59.3 seconds.
All 4 chains finished successfully.
Mean chain execution time: 53.5 seconds.
Total execution time: 59.4 seconds.
pp_check(model_phylo_brain_Cercopithecidae)summary(model_phylo_brain_Cercopithecidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Cercopithecidae (Number of observations: 22)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 11)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.18 0.05 0.11 0.30 1.00 1656 2863
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.28 0.32 0.01 1.14 1.00
sd(log10_body_size) 0.15 0.19 0.00 0.66 1.00
cor(Intercept,log10_body_size) -0.09 0.60 -0.98 0.95 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3340 3599
sd(log10_body_size) 1927 4060
cor(Intercept,log10_body_size) 4626 4229
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept 1.66 0.47 0.60 2.48 1.00 2504 2735
log10_body_size 0.09 0.15 -0.20 0.42 1.00 2241 2843
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.02 0.01 0.01 0.04 1.00 1766 2472
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Cercopithecidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.49 0.33 0.02 0.99 0.23
Post.Prob Star
1 0.18 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Cercopithecidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Cercopithecidae)$sex)[[1]],
slope = coef(model_phylo_brain_Cercopithecidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Cercopithecidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Cercopithecidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Cercopithecidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female 1.72 0.872 2.41 0.0658 -0.109 0.289
2 male 1.68 0.858 2.35 0.0833 -0.0776 0.296
loo_simple <- loo(model_simple_brain_Cercopithecidae)
loo_phylo <- loo(model_phylo_brain_Cercopithecidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Cercopithecidae 0.0 0.0
model_simple_brain_Cercopithecidae -31.7 3.0
# Filter full data to those families only
dat_organ_Bovidae <- dat_brain_all %>%
filter(family == "Bovidae") %>%
ungroup()
# Check for database/tree species mismatches
setdiff(tree$tip.label, dat_organ_Bovidae$phylo) # Tree species absent in database [1] "Petrochromis_famula" "Lobochilotes_labiatus"
[3] "Simochromis_diagramma" "Petrochromis_orthognathus"
[5] "Ctenochromis_horei" "Limnotilapia_dardennii"
[7] "Gnathochromis_pfefferi" "Tropheus_moorii"
[9] "Tropheus_brichardi" "Haplotaxodon_microlepis"
[11] "Perissodus_microlepis" "Benthochromis_tricoti"
[13] "Cyprichromis_leptosoma" "Greenwoodochromis_christyi"
[15] "Limnochromis_staneri" "Gnathochromis_permaxillaris"
[17] "Baileychromis_centropomoides" "Triglachromis_otostigma"
[19] "Cyphotilapia_frontosa" "Ophthalmotilapia_ventralis"
[21] "Cyathopharynx_furcifer" "Ophthalmotilapia_nasuta"
[23] "Ophthalmotilapia_boops" "Aulonocranus_dewindti"
[25] "Ectodus_descampsii" "Callochromis_melanostigma"
[27] "Xenotilapia_melanogenys" "Xenotilapia_flavipinnis"
[29] "Eretmodus_cyanostictus" "Tanganicodus_irsacae"
[31] "Spathodus_marlieri" "Spathodus_erythrodon"
[33] "Neolamprologus_brichardi" "Julidochromis_regani"
[35] "Julidochromis_marlieri" "Neolamprologus_tetracanthus"
[37] "Telmatochromis_temporalis" "Lepidiolamprologus_elongatus"
[39] "Lepidiolamprologus_profundicola" "Lepidiolamprologus_nkambae"
[41] "Altolamprologus_compressiceps" "Neolamprologus_brevis"
[43] "Chalinochromis_brichardi" "Julidochromis_ornatus"
[45] "Lamprologus_ornatipinnis" "Neolamprologus_pulcher"
[47] "Variabilichromis_moorii" "Neolamprologus_tretocephalus"
[49] "Neolamprologus_sexfasciatus" "Trematocara_unimaculatum"
[51] "Hemibates_stenosoma" "Bathybates_ferox"
[53] "Oreochromis_niloticus" "Poecilia_reticulata"
[55] "Nerophis_lumbriciformis" "Syngnathus_abaster"
[57] "Syngnathus_schlegeli" "Hippocampus_comes"
[59] "Hippocampus_trimaculatus" "Hippocampus_kuda"
[61] "Hippocampus_spinosissimus" "Hippocampus_abdominalis"
[63] "Hippichthys_cyanospilos" "Syngnathoides_biaculeatus"
[65] "Corythoichthys_intestinalis" "Corythoichthys_haematopterus"
[67] "Doryichthys_boaja" "Doryrhamphus_japonicus"
[69] "Entelurus_aequoreus" "Anguilla_anguilla"
[71] "Pteropus_alecto" "Pteropus_poliocephalus"
[73] "Pteropus_scapulatus" "Lasiopodomys_brandtii"
[75] "Rattus_norvegicus" "Mus_musculus"
[77] "Meriones_unguiculatus" "Chlorocebus_aethiops"
[79] "Chlorocebus_sabaeus" "Erythrocebus_patas"
[81] "Papio_cynocephalus" "Papio_anubis"
[83] "Cercocebus_atys" "Macaca_arctoides"
[85] "Macaca_mulatta" "Macaca_fascicularis"
[87] "Macaca_maura" "Trachypithecus_francoisi"
[89] "Phrynocephalus_vlangalii" "Platycercus_caledonicus"
[91] "Platycercus_elegans" "Platycercus_eximius"
[93] "Platycercus_venustus" "Barnardius_zonarius"
[95] "Northiella_haematogaster" "Lathamus_discolor"
[97] "Neophema_chrysostoma" "Neophema_pulchella"
[99] "Psittacula_krameri" "Eclectus_roratus"
[101] "Aprosmictus_jonquillaceus" "Alisterus_scapularis"
[103] "Alisterus_amboinensis" "Polytelis_alexandrae"
[105] "Trichoglossus_haematodus" "Agapornis_lilianae"
[107] "Agapornis_taranta" "Loriculus_vernalis"
[109] "Ara_ararauna" "Guaruba_guarouba"
[111] "Enicognathus_leptorhynchus" "Pionites_melanocephalus"
[113] "Forpus_coelestis" "Forpus_passerinus"
[115] "Amazona_leucocephala" "Amazona_albifrons"
[117] "Amazona_pretrei" "Amazona_vinacea"
[119] "Amazona_finschi" "Amazona_amazonica"
[121] "Amazona_ochrocephala" "Amazona_aestiva"
[123] "Brotogeris_versicolurus" "Brotogeris_pyrrhoptera"
[125] "Bolborhynchus_lineola" "Poicephalus_gulielmi"
[127] "Poicephalus_meyeri" "Psittacus_erithacus"
[129] "Serinus_mennelli" "Ficedula_hypoleuca"
[131] "Padda_oryzivora" "Lonchura_punctulata"
[133] "Lonchura_flaviprymna" "Lonchura_bicolor"
[135] "Hypargos_niveoguttatus" "Pytilia_hypogrammica"
[137] "Uraeginthus_bengalus" "Amandava_amandava"
[139] "Plectrophenax_nivalis" "Serinus_canaria"
[141] "Serinus_serinus" "Loxia_curvirostra"
[143] "Carduelis_carduelis" "Carpodacus_roseus"
[145] "Uragus_sibiricus" "Pyrrhula_pyrrhula"
[147] "Pinicola_enucleator" "Bucanetes_githagineus"
[149] "Coccothraustes_coccothraustes" "Mycerobas_affinis"
[151] "Mycerobas_carnipes" "Fringilla_montifringilla"
[153] "Fringilla_coelebs" "Anas_platyrhynchos"
[155] "Anas_acuta" "Anas_crecca"
[157] "Mergus_serrator" "Mergus_merganser"
[159] "Bucephala_clangula" "Melanitta_nigra"
[161] "Somateria_mollissima" "Callonetta_leucophrys"
[163] "Branta_bernicla" "Branta_leucopsis"
[165] "Anser_anser" "Cygnus_columbianus"
[167] "Tadorna_tadorna" "Coturnix_japonica"
[169] "Pucrasia_macrolopha" "Phasianus_colchicus"
[171] "Chrysolophus_pictus" "Lophura_nycthemera"
[173] "Lophura_ignita" "Syrmaticus_ellioti"
[175] "Syrmaticus_reevesii" "Perdix_perdix"
[177] "Tetrao_urogallus" "Lagopus_muta"
[179] "Lagopus_lagopus" "Lophophorus_impejanus"
[181] "Tragopan_temminckii" "Pavo_cristatus"
[183] "Gallus_gallus" "Gallus_sonneratii"
[185] "Rollulus_rouloul" "Arborophila_torqueola"
[187] "Numida_meleagris"
setdiff(dat_organ_Bovidae$phylo, tree$tip.label) # Database species absent in treecharacter(0)
# Exclude mismatched species for consistency
tree_organ <- keep.tip(tree, intersect(tree$tip.label, dat_organ_Bovidae$phylo))
dat_organ_Bovidae <- dat_organ_Bovidae[dat_organ_Bovidae$phylo %in% tree_organ$tip.label, ]
# Re-check for mismatches after pruning
setdiff(tree_organ$tip.label, dat_organ_Bovidae$phylo)character(0)
setdiff(dat_organ_Bovidae$phylo, tree_organ$tip.label)character(0)
# Is ultrametric?
is.ultrametric(tree_organ)[1] TRUE
# how many species?
length(tree_organ$tip.label)[1] 17
# Compute phylogenetic covariance matrix
A_organ <- ape::vcv.phylo(tree_organ, corr = TRUE)model_simple_brain_Bovidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex),
data = dat_organ_Bovidae,
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 2 finished in 13.7 seconds.
Chain 3 finished in 13.7 seconds.
Chain 1 finished in 20.0 seconds.
Chain 4 finished in 25.5 seconds.
All 4 chains finished successfully.
Mean chain execution time: 18.2 seconds.
Total execution time: 25.6 seconds.
pp_check(model_simple_brain_Bovidae)summary(model_simple_brain_Bovidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex)
Data: dat_organ_Bovidae (Number of observations: 34)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.27 0.32 0.01 1.10 1.00
sd(log10_body_size) 0.13 0.19 0.00 0.62 1.00
cor(Intercept,log10_body_size) -0.10 0.60 -0.98 0.94 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2656 2965
sd(log10_body_size) 1421 2759
cor(Intercept,log10_body_size) 3888 3628
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.61 0.31 -1.33 -0.10 1.00 3725 3385
log10_body_size 0.57 0.11 0.26 0.78 1.00 1589 1271
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.07 0.01 0.06 0.10 1.00 5645 4981
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
I will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_simple_brain_Bovidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_simple_brain_Bovidae)$sex)[[1]],
slope = coef(model_simple_brain_Bovidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_simple_brain_Bovidae)$sex)[[1]],
slope_low = coef(model_simple_brain_Bovidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_simple_brain_Bovidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.564 -0.837 -0.298 0.585 0.530 0.641
2 male -0.561 -0.832 -0.293 0.584 0.529 0.640
model_phylo_brain_Bovidae <- brm(
log10_organ_size ~
1 +
log10_body_size +
(1 + log10_body_size | sex) +
(1 | gr(phylo, cov = A_organ)),
data = dat_organ_Bovidae,
data2 = list(A_organ = A_organ),
family = gaussian(),
prior = c(
prior(normal(0.75, 0.5), class = "b", coef = "log10_body_size"),
prior(normal(0, 2), class = "Intercept"),
prior(student_t(3, 0, 0.5), class = "sd"),
prior(student_t(3, 0, 1), class = "sigma")
),
seed = 6955,
sample_prior = TRUE,
chains = 4,
cores = 4,
threads = threading(2),
iter = 4000,
warmup = 2000,
control = list(max_treedepth = 15,
adapt_delta = 0.99),
save_pars = save_pars(all = TRUE),
silent = TRUE, refresh = 0
)Running MCMC with 4 parallel chains, with 2 thread(s) per chain...
Chain 1 finished in 37.8 seconds.
Chain 4 finished in 38.6 seconds.
Chain 3 finished in 43.9 seconds.
Chain 2 finished in 97.1 seconds.
All 4 chains finished successfully.
Mean chain execution time: 54.4 seconds.
Total execution time: 97.2 seconds.
pp_check(model_phylo_brain_Bovidae)summary(model_phylo_brain_Bovidae) Family: gaussian
Links: mu = identity; sigma = identity
Formula: log10_organ_size ~ 1 + log10_body_size + (1 + log10_body_size | sex) + (1 | gr(phylo, cov = A_organ))
Data: dat_organ_Bovidae (Number of observations: 34)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~phylo (Number of levels: 17)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.08 0.02 0.05 0.14 1.00 1575 2603
~sex (Number of levels: 2)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.24 0.29 0.00 0.98 1.00
sd(log10_body_size) 0.12 0.18 0.00 0.61 1.00
cor(Intercept,log10_body_size) -0.07 0.62 -0.98 0.96 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3083 3525
sd(log10_body_size) 1590 3350
cor(Intercept,log10_body_size) 5108 4908
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.50 0.32 -1.20 0.10 1.00 3586 4463
log10_body_size 0.55 0.11 0.25 0.74 1.00 1747 1526
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.04 0.01 0.03 0.06 1.00 2113 2812
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
hyp <- paste(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
(hyp <- hypothesis(model_phylo_brain_Bovidae, hyp, class = NULL))Hypothesis Tests for class :
Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
1 (sd_phylo__Interc... = 0 0.32 0.29 0.01 0.88 0.61
Post.Prob Star
1 0.38 *
---
'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
'*': For one-sided hypotheses, the posterior probability exceeds 95%;
for two-sided hypotheses, the value tested against lies outside the 95%-CI.
Posterior probabilities of point hypotheses assume equal prior probabilities.
lambda_brain <- hyp$hypothesis$EstimateI will next extract, for each sex, the estimated slope and intercept, together with the 95% credible intervals.
# Extract combined coefficients (fixed + random)
coef(model_phylo_brain_Bovidae)$sex %>%
{tibble(
sex = dimnames(.)[[1]],
intercept = .[, "Estimate", "Intercept"],
intercept_low = .[, "Q2.5", "Intercept"],
intercept_high = .[, "Q97.5", "Intercept"]
)} %>%
bind_cols(
tibble(
sex = dimnames(coef(model_phylo_brain_Bovidae)$sex)[[1]],
slope = coef(model_phylo_brain_Bovidae)$sex[, "Estimate", "log10_body_size"]
) %>% select(slope),
tibble(
sex = dimnames(coef(model_phylo_brain_Bovidae)$sex)[[1]],
slope_low = coef(model_phylo_brain_Bovidae)$sex[, "Q2.5", "log10_body_size"],
slope_high = coef(model_phylo_brain_Bovidae)$sex[, "Q97.5", "log10_body_size"]
) %>% select(slope_low, slope_high)
)# A tibble: 2 × 7
sex intercept intercept_low intercept_high slope slope_low slope_high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 female -0.486 -0.895 -0.0279 0.568 0.477 0.651
2 male -0.475 -0.873 -0.0117 0.566 0.474 0.646
loo_simple <- loo(model_simple_brain_Bovidae)
loo_phylo <- loo(model_phylo_brain_Bovidae)
loo_compare(loo_simple, loo_phylo) elpd_diff se_diff
model_phylo_brain_Bovidae 0.0 0.0
model_simple_brain_Bovidae -11.2 3.3
The next task is to extract the coefficients from all models (8) in order to prepare a table (Table S2 in the paper) that presents the coefficients by sex, global coefficients. Additionally, I will include the Pagel’s \(\lambda\) representing the phylogenetic signal.
# list of models (no brain included, for now)
models_list_simple <- list(
model_simple_liver,
model_simple_heart,
model_simple_pituitary_glands,
model_simple_spleen,
model_simple_stomach,
model_simple_lungs,
model_simple_adrenal_glands,
model_simple_kidneys
)
models_list_phylo <- list(
model_phylo_liver,
model_phylo_heart,
model_phylo_pituitary_glands,
model_phylo_spleen,
model_phylo_stomach,
model_phylo_lungs,
model_phylo_adrenal_glands,
model_phylo_kidneys
)
# Organ names for simple models
names(models_list_simple) <- c(
"liver","heart","pituitary_glands","spleen",
"stomach","lungs","adrenal_glands","kidneys"
)
# Organ names for phylogenetic models
names(models_list_phylo) <- c(
"liver","heart","pituitary_glands","spleen",
"stomach","lungs","adrenal_glands","kidneys"
)
# Hypothesis string for lambda (phylogenetic signal), based on the vignette
# available here:
# https://cran.r-project.org/web/packages/brms/vignettes/brms_phylogenetics.html
hyp_lambda <- paste0(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
# Make a function to do the process less repetitive. It will extract from each
# model sex-specific coefficients + global slope + lambda (for phylo models only)
extract_all_coefs <- function(fit, organ, model_type) {
# Sex-specific coefficients (random effects)
coef_sex <- coef(fit)$sex %>%
as_tibble(rownames = "sex") %>%
select(sex, matches("Estimate|Q2.5|Q97.5")) %>%
transmute(
model_type,
organ,
sex,
intercept = Estimate.Intercept,
intercept_low = Q2.5.Intercept,
intercept_high = Q97.5.Intercept,
slope = Estimate.log10_body_size,
slope_low = Q2.5.log10_body_size,
slope_high = Q97.5.log10_body_size
)
# Global slope (fixed effect)
global_slope_vec <- fixef(fit)["log10_body_size", ]
global_slope <- tibble(
global_slope = global_slope_vec["Estimate"],
global_slope_low = global_slope_vec["Q2.5"],
global_slope_high = global_slope_vec["Q97.5"]
)
# Lambda (phylogenetic signal) - only for phylo models
if(model_type == "phylo") {
hyp_lambda <- hypothesis(fit, hyp_lambda, class = NULL)
lambda_vals <- hyp_lambda$hypothesis %>%
transmute(
lambda = Estimate
)
} else {
lambda_vals <- tibble(lambda = NA_real_)
}
# Combine everything
coef_sex %>%
bind_cols(global_slope, lambda_vals)
}
# Create complete data frames
df_simple_all_organs <- imap_dfr(
models_list_simple,
~ extract_all_coefs(.x, organ = .y, model_type = "simple")
)
df_phylo_all_organs <- imap_dfr(
models_list_phylo,
~ extract_all_coefs(.x, organ = .y, model_type = "phylo")
)
# Final data frame with everything
df_all_organs <- bind_rows(df_simple_all_organs, df_phylo_all_organs)
# add R²
r2_simple <- imap(models_list_simple, ~ bayes_R2(.x)["R2", "Estimate"])
r2_phylo <- imap(models_list_phylo, ~ bayes_R2(.x)["R2", "Estimate"])
df_all_organs <- df_all_organs %>%
arrange(model_type,organ) %>%
mutate(R2 = case_when(
model_type == "simple" ~ r2_simple[organ],
model_type == "phylo" ~ r2_phylo[organ]
))df_all_organs_ci <- df_all_organs %>%
mutate(
lambda = as.numeric(lambda),
R2 = as.numeric(R2),
intercept_ci = sprintf("%.2f [%.2f, %.2f]",
round(intercept, 2), round(intercept_low, 2), round(intercept_high, 2)),
slope_ci = sprintf("%.2f [%.2f, %.2f]",
round(slope, 2), round(slope_low, 2), round(slope_high, 2)),
global_slope_ci = sprintf("%.2f [%.2f, %.2f]",
round(global_slope, 2), round(global_slope_low, 2), round(global_slope_high, 2)),
lambda = sprintf("%.2f", round(lambda, 2)),
R2 = sprintf("%.2f", round(R2, 2))
) %>%
mutate(across(where(is.list), as.character)) %>%
select(model_type, organ, sex, intercept_ci, slope_ci, global_slope_ci, lambda, R2) %>%
arrange(organ) %>%
as.data.frame(stringsAsFactors = FALSE)
# Table with filters
df_all_organs_ci %>%
datatable(
filter = 'top',
options = list(
columnDefs = list(
list(width = "5%", targets = 0),
list(width = "15%", targets = 1),
list(width = "7%", targets = 2),
list(width = "17%", targets = 3),
list(width = "17%", targets = 4),
list(width = "17%", targets = 5),
list(width = "7%", targets = 6),
list(width = "7%", targets = 7)
),
pageLength = 25,
scrollX = TRUE,
autoWidth = FALSE
),
class = 'cell-border stripe hover',
escape = FALSE
) %>%
formatStyle(columns = 0:7, borderRight = "1px solid #ddd")What I will do here is copy the list of simple and phylogenetic models, their names, and extract the LOO values. Then, I will compare these using the loo_compare function, extract the estimates from this comparison, and plot them.
# Define model lists
models_list_simple <- list(
model_simple_liver, model_simple_heart, model_simple_pituitary_glands,
model_simple_spleen, model_simple_stomach, model_simple_lungs,
model_simple_adrenal_glands, model_simple_kidneys
)
names(models_list_simple) <- c(
"liver", "heart", "pituitary_glands", "spleen",
"stomach", "lungs", "adrenal_glands", "kidneys"
)
names(models_list_phylo) <- names(models_list_simple)
# Compare models and extract elpd_diff + se
diff_by_organ <- map_dfr(names(models_list_simple), function(org) {
# 1. Calcular LOO
loo_phylo <- loo(models_list_phylo[[org]])
loo_simple <- loo(models_list_simple[[org]])
# 2. Comparar
comp <- loo_compare(loo_phylo, loo_simple)
comp_df <- as.data.frame(comp)
# 3. Extraer fila NO referencia (modelo simple)
row <- comp_df[comp_df$elpd_diff != 0, , drop = FALSE]
# Seguridad (debería ser exactamente 1 fila)
if (nrow(row) != 1) {
stop("Unexpected loo_compare output for organ: ", org)
}
# 4. Construir salida
tibble(
organ = gsub("_", " ", org),
diff_elpd = -row$elpd_diff, # phylo − simple
se_diff = row$se_diff,
Vetahri_score = abs((-row$elpd_diff) / row$se_diff)
)
}) %>%
mutate(
sig_level = if_else(Vetahri_score > 4, "large", "ns")
) %>%
arrange(desc(diff_elpd))
# Figure 2
Figure_2a <- ggplot(diff_by_organ, aes(x = reorder(organ, diff_elpd), y = diff_elpd,
colour = sig_level)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = diff_elpd - se_diff, ymax = diff_elpd + se_diff),
width = 0.3, linewidth = 0.8) +
coord_flip() +
scale_colour_manual(
values = c("ns" = "grey30", "large" = "#009E73"),
name = "Model improvement",
labels = c("ns" = expression(z <= 4), "large" = expression(z > 4))
) +
labs(
x = NULL,
y = expression(Delta ~ "ELPD" ~ "(phylogenetic - simple)")
) +
theme_pubr(base_size = 12) +
theme(
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 12),
axis.title.y = element_text(size = 12),
legend.position = c(0.85, 0.15),
legend.margin = margin(3, 3, 3, 3),
legend.box.just = "left",
legend.title = element_text(size = 10)
)
Figure_2a# list of models (only brain)
models_list_simple_brain <- list(
model_simple_brain_Cichlidae,
model_simple_brain_Syngnathidae,
model_simple_brain_Psittacidae,
model_simple_brain_Fringillidae,
model_simple_brain_Phasianidae,
model_simple_brain_Anatidae,
model_simple_brain_Cercopithecidae,
model_simple_brain_Bovidae
)
models_list_phylo_brain <- list(
model_phylo_brain_Cichlidae,
model_phylo_brain_Syngnathidae,
model_phylo_brain_Psittacidae,
model_phylo_brain_Fringillidae,
model_phylo_brain_Phasianidae,
model_phylo_brain_Anatidae,
model_phylo_brain_Cercopithecidae,
model_phylo_brain_Bovidae
)
# family names for simple models
names(models_list_simple_brain) <- c(
"Cichlidae","Syngnathidae","Psittacidae","Fringillidae",
"Phasianidae","Anatidae","Cercopithecidae","Bovidae"
)
# Organ names for phylogenetic models
names(models_list_phylo_brain) <- names(models_list_simple_brain)
# Compare models and extract elpd_diff + se
diff_by_family <- map_dfr(names(models_list_simple_brain), function(fam) {
# 1. Calcular LOO
loo_phylo_brain <- loo(models_list_phylo_brain[[fam]])
loo_simple_brain <- loo(models_list_simple_brain[[fam]])
# 2. Comparar
comp <- loo_compare(loo_phylo_brain, loo_simple_brain)
comp_df_brain <- as.data.frame(comp)
# 3. Extraer fila NO referencia (modelo simple)
row <- comp_df_brain[comp_df_brain$elpd_diff != 0, , drop = FALSE]
# Seguridad (debería ser exactamente 1 fila)
if (nrow(row) != 1) {
stop("Unexpected loo_compare output for organ: ", fam)
}
# 4. Construir salida
tibble(
family = gsub("_", " ", fam),
diff_elpd = -row$elpd_diff, # phylo − simple
se_diff = row$se_diff,
Vetahri_score = abs((-row$elpd_diff) / row$se_diff)
)
}) %>%
mutate(
sig_level = if_else(Vetahri_score > 4, "large", "ns")
) %>%
arrange(desc(diff_elpd))
Figure_2b <- ggplot(diff_by_family, aes(x = reorder(family, diff_elpd), y = diff_elpd,
colour = sig_level)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = diff_elpd - se_diff, ymax = diff_elpd + se_diff),
width = 0.3, linewidth = 0.8) +
coord_flip() +
scale_colour_manual(
values = c("ns" = "grey30", "large" = "#009E73"),
name = "Model improvement",
labels = c("ns" = expression(z <= 4), "large" = expression(z > 4))
) +
labs(
x = NULL,
y = expression(Delta ~ "ELPD" ~ "(phylogenetic - simple)")
) +
theme_pubr(base_size = 12) +
theme(
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 12),
axis.title.y = element_text(size = 12),
legend.position = c(0.85, 0.15),
legend.margin = margin(3, 3, 3, 3),
legend.box.just = "left",
legend.title = element_text(size = 10)
)
Figure_2bFigure_2 <- plot_grid(Figure_2a, Figure_2b,
labels = c("A", "B"),
ncol = 1,
align = "hv")
# Export figure
ggsave("../outputs/Figure_2.pdf", Figure_2, width = 5, height = 7)This figure comprises four plots. Two of these depict the relationships between slopes and intercepts for males and females derived from phylogenetic models. The other two present similar information but based on simple models (without phylogenetic information). Displaying slopes and intercepts from both model types was pragmatic, as the importance of accounting for phylogeny varies by organ—some require it, while others show phylogenetic contributions comparable to excluding it.
# Define common theme (used by all plots)
common_theme <- theme_bw() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = c(0.15, 0.85),
legend.key.size = unit(0.4, "cm"),
legend.text = element_text(size = 8),
legend.title = element_blank(),
legend.spacing.y = unit(0.5, "cm"),
legend.margin = margin(2, 2, 2, 2),
legend.background = element_rect(fill = "white", size = 0.3),
plot.margin = margin(15, 15, 15, 15),
axis.text = element_text(size = 12),
axis.title = element_text(size = 12),
axis.title.x = element_text(margin = margin(t = 12)),
axis.title.y = element_text(margin = margin(r = 5)),
panel.border = element_rect(colour = "black", fill = NA, size = 1)
)
# Define legend theme
no_legend_theme <- theme_bw() +
theme(
panel.grid = element_blank(),
legend.position = "left",
plot.margin = margin(15, 15, 15, 15),
axis.text = element_text(size = 12),
axis.title = element_text(size = 12),
axis.title.x = element_text(margin = margin(t = 12)),
axis.title.y = element_text(margin = margin(r = 5)),
panel.border = element_rect(colour = "black", fill = NA, size = 1)
)
# Clean organ names and colours
df_all_organs$organ <- gsub("_", " ", df_all_organs$organ)
all_organs <- sort(unique(df_all_organs$organ))
my_cols <- setNames(c("#4169E1", "#DC143C", "#D1600F", "#8B0000",
"#FFFF00", "#8DA715", "#FF69B4", "black"),
all_organs)
# Plot 1: slopes - phylogenetic model (with legend)
df1 <- df_all_organs %>%
filter(model_type == "phylo", sex %in% c("male", "female")) %>%
select(organ, sex, slope, slope_low, slope_high) %>%
pivot_wider(names_from = sex, values_from = c(slope, slope_low, slope_high), names_sep = "_") %>%
mutate(male_xmin = slope_low_male, male_xmax = slope_high_male,
female_ymin = slope_low_female, female_ymax = slope_high_female)
p1 <- ggplot(df1, aes(x = slope_male, y = slope_female)) +
geom_errorbarh(aes(xmin = male_xmin, xmax = male_xmax, colour = organ), height = 0.038, size = 0.8) +
geom_errorbar(aes(ymin = female_ymin, ymax = female_ymax, colour = organ), width = 0.038, size = 0.8) +
geom_point(aes(fill = organ), size = 2.8, shape = 21, stroke = 0.6, colour = "white") +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", colour = "grey40", size = 0.6, alpha = 0.5) +
scale_colour_manual(values = my_cols) +
scale_fill_manual(values = my_cols, guide = "none") +
guides(colour = guide_legend(
override.aes = list(shape = 21, colour = "white", stroke = 0.6, size = 3))) +
labs(x = "Male slope", y = "Female slope") +
coord_fixed() + common_theme +
scale_x_continuous(limits = c(0, 1.5), breaks = seq(0, 1.5, by = 0.3)) +
scale_y_continuous(limits = c(0, 1.5), breaks = seq(0, 1.5, by = 0.3))
# Plot 2: slopes - simple model
df2 <- df_all_organs %>%
filter(model_type == "simple", sex %in% c("male", "female")) %>%
select(organ, sex, slope, slope_low, slope_high) %>%
pivot_wider(names_from = sex, values_from = c(slope, slope_low, slope_high), names_sep = "_") %>%
mutate(male_xmin = slope_low_male, male_xmax = slope_high_male,
female_ymin = slope_low_female, female_ymax = slope_high_female)
p2 <- ggplot(df2, aes(x = slope_male, y = slope_female)) +
geom_errorbarh(aes(xmin = male_xmin, xmax = male_xmax, colour = organ), height = 0.038, size = 0.8) +
geom_errorbar(aes(ymin = female_ymin, ymax = female_ymax, colour = organ), width = 0.038, size = 0.8) +
geom_point(aes(fill = organ), size = 2.8, shape = 21, stroke = 0.6, colour = "white") +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", colour = "grey40", size = 0.6, alpha = 0.5) +
scale_colour_manual(values = my_cols, guide = "none") +
scale_fill_manual(values = my_cols, guide = "none") +
labs(x = "Male slope", y = "") +
coord_fixed() + no_legend_theme +
scale_x_continuous(limits = c(0, 1.5), breaks = seq(0, 1.5, by = 0.3)) +
scale_y_continuous(limits = c(0, 1.5), breaks = seq(0, 1.5, by = 0.3))
# Plot 3: intercepts - phylogenetic model
df3 <- df_all_organs %>%
filter(model_type == "phylo", sex %in% c("male", "female")) %>%
select(organ, sex, intercept, intercept_low, intercept_high) %>%
pivot_wider(names_from = sex, values_from = c(intercept, intercept_low, intercept_high), names_sep = "_") %>%
mutate(male_xmin = intercept_low_male, male_xmax = intercept_high_male,
female_ymin = intercept_low_female, female_ymax = intercept_high_female)
p3 <- ggplot(df3, aes(x = intercept_male, y = intercept_female)) +
geom_errorbarh(aes(xmin = male_xmin, xmax = male_xmax, colour = organ), height = 0.12, size = 0.8) +
geom_errorbar(aes(ymin = female_ymin, ymax = female_ymax, colour = organ), width = 0.12, size = 0.8) +
geom_point(aes(fill = organ), size = 2.8, shape = 21, stroke = 0.6, colour = "white") +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", colour = "grey40", size = 0.6, alpha = 0.5) +
scale_colour_manual(values = my_cols, guide = "none") +
scale_fill_manual(values = my_cols, guide = "none") +
labs(x = "Male intercept", y = "Female intercept") +
coord_fixed() + no_legend_theme +
scale_x_continuous(limits = c(-5, 0), breaks = seq(-5, 0, by = 1)) +
scale_y_continuous(limits = c(-5, 0), breaks = seq(-5, 0, by = 1))
# Plot 4: intercepts - simple model
df4 <- df_all_organs %>%
filter(model_type == "simple", sex %in% c("male", "female")) %>%
select(organ, sex, intercept, intercept_low, intercept_high) %>%
pivot_wider(names_from = sex, values_from = c(intercept, intercept_low, intercept_high), names_sep = "_") %>%
mutate(male_xmin = intercept_low_male, male_xmax = intercept_high_male,
female_ymin = intercept_low_female, female_ymax = intercept_high_female)
p4 <- ggplot(df4, aes(x = intercept_male, y = intercept_female)) +
geom_errorbarh(aes(xmin = male_xmin, xmax = male_xmax, colour = organ), height = 0.12, size = 0.8) +
geom_errorbar(aes(ymin = female_ymin, ymax = female_ymax, colour = organ), width = 0.12, size = 0.8) +
geom_point(aes(fill = organ), size = 2.8, shape = 21, stroke = 0.6, colour = "white") +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", colour = "grey40", size = 0.6, alpha = 0.5) +
scale_colour_manual(values = my_cols, guide = "none") +
scale_fill_manual(values = my_cols, guide = "none") +
labs(x = "Male intercept", y = "") +
coord_fixed() + no_legend_theme +
scale_x_continuous(limits = c(-5, 0), breaks = seq(-5, 0, by = 1)) +
scale_y_continuous(limits = c(-5, 0), breaks = seq(-5, 0, by = 1))
# temporal plot
legend_plot <- ggplot(df1, aes(x = 1, y = 1, fill = organ)) +
geom_point(shape = 21, size = 4, stroke = 0.8, colour = "white") +
scale_fill_manual(values = my_cols) +
theme_void() +
guides(fill = guide_legend(title = NULL, override.aes = list(shape = 21, colour = "white", stroke = 0.6, size = 3))) +
theme(legend.position = "right", legend.spacing.y = unit(0.3, "cm"))
# Extract legend from plot from the previous plot
legend_right <- get_legend(legend_plot+ theme(legend.position = "right", legend.spacing.y = unit(0.3, "cm")))
# Add model labels to panels
p1 <- p1 + theme(legend.position = "none", plot.margin = margin(2, 2, 2, 2)) +
annotate("text", x = 0.75, y = 1.5, label = "Phylogenetic model", size = 4, hjust = 0.5, vjust = 0.5, colour = "black")
p2 <- p2 + theme(legend.position = "none", plot.margin = margin(2, 2, 2, 2)) +
annotate("text", x = 0.75, y = 1.5, label = "Simple model", size = 4, hjust = 0.5, vjust = 0.5, colour = "black")
p3 <- p3 + theme(legend.position = "none", plot.margin = margin(2, 2, 2, 2)) +
annotate("text", x = -2.5, y = 0, label = "Phylogenetic model", size = 4, hjust = 0.5, vjust = 0.5, colour = "black")
p4 <- p4 + theme(legend.position = "none", plot.margin = margin(2, 2, 2, 2)) +
annotate("text", x = -2.5, y = 0, label = "Simple model", size = 4, hjust = 0.5, vjust = 0.5, colour = "black")
# Combine panels and create final figure
combined_plot <- (p1 | p2) / (p3 | p4) + plot_layout(widths = c(1, 1), heights = c(1, 1))
Figure_3 <- plot_grid(combined_plot, legend_right, rel_widths = c(4, 1))
# Export high-resolution figure
ggsave("../outputs/Figure_3.png", Figure_3, width = 8, height = 7, dpi = 1200)
ggsave("../outputs/Figure_3.pdf", Figure_3, width = 8, height = 7)# Hypothesis string for lambda (phylogenetic signal), based on the vignette
# available here:
# https://cran.r-project.org/web/packages/brms/vignettes/brms_phylogenetics.html
hyp_lambda <- paste0(
"sd_phylo__Intercept^2 /",
"(sd_phylo__Intercept^2 + sd_sex__Intercept^2 + sigma^2) = 0"
)
# Make a function to do the process less repetitive. It will extract from each
# model sex-specific coefficients + global slope + lambda (for phylo models only)
extract_all_coefs <- function(fit, family, model_type) {
# Sex-specific coefficients (random effects)
coef_sex <- coef(fit)$sex %>%
as_tibble(rownames = "sex") %>%
select(sex, matches("Estimate|Q2.5|Q97.5")) %>%
transmute(
model_type,
family,
sex,
intercept = Estimate.Intercept,
intercept_low = Q2.5.Intercept,
intercept_high = Q97.5.Intercept,
slope = Estimate.log10_body_size,
slope_low = Q2.5.log10_body_size,
slope_high = Q97.5.log10_body_size
)
# Global slope (fixed effect)
global_slope_vec <- fixef(fit)["log10_body_size", ]
global_slope <- tibble(
global_slope = global_slope_vec["Estimate"],
global_slope_low = global_slope_vec["Q2.5"],
global_slope_high = global_slope_vec["Q97.5"]
)
# Lambda (phylogenetic signal) - only for phylo models
if(model_type == "phylo") {
hyp_lambda <- hypothesis(fit, hyp_lambda, class = NULL)
lambda_vals <- hyp_lambda$hypothesis %>%
transmute(
lambda = Estimate
)
} else {
lambda_vals <- tibble(lambda = NA_real_)
}
# Combine everything
coef_sex %>%
bind_cols(global_slope, lambda_vals)
}
# Create complete data frames
df_simple_all_family <- imap_dfr(
models_list_simple_brain,
~ extract_all_coefs(.x, family = .y, model_type = "simple")
)
df_phylo_all_family<- imap_dfr(
models_list_phylo_brain,
~ extract_all_coefs(.x, family = .y, model_type = "phylo")
)
# Final data frame with everything
df_all_family <- bind_rows(df_simple_all_family, df_phylo_all_family)
# add R²
r2_simple <- imap(models_list_simple_brain, ~ bayes_R2(.x)["R2", "Estimate"])
r2_phylo <- imap(models_list_phylo_brain, ~ bayes_R2(.x)["R2", "Estimate"])
df_all_family <- df_all_family %>%
arrange(model_type,family) %>%
mutate(R2 = case_when(
model_type == "simple" ~ r2_simple[family],
model_type == "phylo" ~ r2_phylo[family]
))df_all_family <- df_all_family %>%
mutate(
lambda = as.numeric(lambda),
R2 = as.numeric(R2),
intercept_ci = sprintf("%.2f [%.2f, %.2f]",
round(intercept, 2), round(intercept_low, 2), round(intercept_high, 2)),
slope_ci = sprintf("%.2f [%.2f, %.2f]",
round(slope, 2), round(slope_low, 2), round(slope_high, 2)),
global_slope_ci = sprintf("%.2f [%.2f, %.2f]",
round(global_slope, 2), round(global_slope_low, 2), round(global_slope_high, 2)),
lambda = sprintf("%.2f", round(lambda, 2)),
R2 = sprintf("%.2f", round(R2, 2))
) %>%
mutate(across(where(is.list), as.character)) %>%
select(model_type, family, sex, intercept_ci, slope_ci, global_slope_ci, lambda, R2) %>%
arrange(family) %>%
as.data.frame(stringsAsFactors = FALSE)
# Table with filters remains identical
df_all_family %>%
datatable(
filter = 'top',
options = list(
columnDefs = list(
list(width = "5%", targets = 0),
list(width = "15%", targets = 1),
list(width = "7%", targets = 2),
list(width = "17%", targets = 3),
list(width = "17%", targets = 4),
list(width = "17%", targets = 5),
list(width = "7%", targets = 6),
list(width = "7%", targets = 7)
),
pageLength = 25,
scrollX = TRUE,
autoWidth = FALSE
),
class = 'cell-border stripe hover',
escape = FALSE
) %>%
formatStyle(columns = 0:7, borderRight = "1px solid #ddd")models_list_phylo_brain <- list(
model_phylo_brain_Cichlidae,
model_phylo_brain_Syngnathidae,
model_phylo_brain_Psittacidae,
model_phylo_brain_Fringillidae,
model_phylo_brain_Phasianidae,
model_phylo_brain_Anatidae,
model_phylo_brain_Cercopithecidae,
model_phylo_brain_Bovidae
)
family_names <- c("Cichlidae", "Syngnathidae", "Psittacidae", "Fringillidae",
"Phasianidae", "Anatidae", "Cercopithecidae", "Bovidae")
sex_colours <- c("male" = "#FF0000A0", "female" = "#1F78B4", "Grand mean" = "gray70")
common_theme <- theme_bw(base_size = 12) +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "none",
panel.spacing.x = unit(0.3, "lines"),
axis.text.y = element_blank(),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(margin = margin(t = 8)),
axis.title.y = element_text(margin = margin(r = 8)),
axis.title = element_text(size = 14),
plot.margin = margin(t = 4, r = 8, b = 4, l = 8, unit = "pt")
)
plot_slopes <- function(model, family_name) {
fixed_effects <- model %>% spread_draws(b_log10_body_size)
random_slopes <- model %>%
gather_draws(r_sex[sex, term], regex = TRUE) %>%
filter(term == "log10_body_size")
slope_draws <- random_slopes %>%
left_join(fixed_effects, by = ".draw") %>%
mutate(slope = .value + b_log10_body_size, sex_label = glue::glue("{sex}")) %>%
select(.draw, sex_label, slope)
global_slope_draws <- fixed_effects %>%
mutate(slope = b_log10_body_size, sex_label = "Grand mean") %>%
select(.draw, sex_label, slope)
slope_draws_combined <- bind_rows(slope_draws, global_slope_draws)
slope_draws_combined$sex_label <- factor(
slope_draws_combined$sex_label,
levels = c(sort(unique(slope_draws$sex_label)), "Grand mean")
)
ggplot(slope_draws_combined, aes(x = slope, y = sex_label, fill = sex_label)) +
annotate("rect",
xmin = -0.6, xmax = 1.6,
ymin = 3.69, ymax = 3.99,
fill = 'grey90', color = NA) +
annotate("text",
x = 0.5, y = 3.85,
label = family_name,
size = 4.5, fontface = "bold",
hjust = 0.5, vjust = 0.5) +
stat_halfeye(aes(x = slope), scale = 0.8, justification = 0.08) +
scale_y_discrete(expand = expansion(mult = c(0.02, 0.35))) +
coord_cartesian(xlim = c(-0.5, 1.5), clip = "off") +
scale_fill_manual(values = sex_colours) +
labs(x = "", y = NULL, title = NULL) +
common_theme
}
plot_intercepts <- function(model, family_name) {
fixed_effects <- model %>% spread_draws(b_Intercept)
random_intercepts <- model %>%
gather_draws(r_sex[sex, term], regex = TRUE) %>%
filter(term == "Intercept")
intercept_draws <- random_intercepts %>%
left_join(fixed_effects, by = c(".chain", ".iteration", ".draw")) %>%
mutate(intercept = .value + b_Intercept, sex_label = glue::glue("{sex}")) %>%
select(.draw, sex_label, intercept)
global_intercept_draws <- fixed_effects %>%
mutate(intercept = b_Intercept, sex_label = "Grand mean") %>%
select(.draw, sex_label, intercept)
intercept_draws_combined <- bind_rows(intercept_draws, global_intercept_draws)
intercept_draws_combined$sex_label <- factor(
intercept_draws_combined$sex_label,
levels = c(sort(unique(intercept_draws$sex_label)), "Grand mean")
)
ggplot(intercept_draws_combined, aes(x = intercept, y = sex_label, fill = sex_label)) +
annotate(
"rect",
xmin = -Inf, xmax = Inf,
ymin = 3.69, ymax = 3.99,
fill = "grey90", color = NA
) +
annotate(
"text",
x = 0, y = 3.85,
label = family_name,
size = 4.5, fontface = "bold",
hjust = 0.5, vjust = 0.5
) +
stat_halfeye(scale = 0.8, justification = 0.08) +
scale_x_continuous(breaks = seq(-3, 3, 1.5)) +
scale_y_discrete(expand = expansion(mult = c(0.02, 0.35))) +
coord_cartesian(xlim = c(-3.2, 3.2), clip = "off") +
scale_fill_manual(values = sex_colours) +
labs(x = "", y = NULL) +
common_theme
}
# make PLOTS
intercept_plots <- map2(models_list_phylo_brain, family_names, plot_intercepts)
slope_plots <- map2(models_list_phylo_brain, family_names, plot_slopes)
Figure_4_intercepts <- plot_grid(
plotlist = intercept_plots,
ncol = 2,
align = "hv",
rel_heights = rep(1, 4)
)
Figure_4_slopes <- plot_grid(
plotlist = slope_plots,
ncol = 2,
align = "hv",
rel_heights = rep(1, 4)
)
Figure_4 <- plot_grid(
Figure_4_intercepts,
Figure_4_slopes,
ncol = 2,
rel_widths = c(1, 1),
align = "hv"
)
ggsave("../outputs/Figure_4.png", Figure_4, width = 14, height = 13, dpi = 1200)
ggsave("../outputs/Figure_4.pdf", Figure_4, width = 14, height = 13)R version 4.3.2 (2023-10-31)
Platform: aarch64-apple-darwin20 (64-bit)
attached base packages: stats, graphics, grDevices, utils, datasets, methods and base
other attached packages: rstan(v.2.32.7), StanHeaders(v.2.32.10), ggtreeExtra(v.1.12.0), ggnewscale(v.0.5.2), DT(v.0.33), ggridges(v.0.5.6), RColorBrewer(v.1.1-3), modelr(v.0.1.11), broom(v.1.0.8), viridis(v.0.6.5), viridisLite(v.0.4.2), posterior(v.1.6.1), lubridate(v.1.9.4), forcats(v.1.0.0), readr(v.2.1.5), tidyverse(v.2.0.0), furrr(v.0.3.1), future(v.1.40.0), cmdstanr(v.0.9.0), purrr(v.1.0.4), loo(v.2.8.0), bayestestR(v.0.16.1), tidybayes(v.3.0.7), bayesplot(v.1.13.0), dplyr(v.1.1.4), brms(v.2.22.0), Rcpp(v.1.1.0), tidyr(v.1.3.1), stringr(v.1.5.1), details(v.0.4.0), ggthemes(v.5.1.0), tibble(v.3.2.1), ggtree(v.3.10.1), patchwork(v.1.3.0), cowplot(v.1.1.3), ggpubr(v.0.6.0), ggplot2(v.3.5.2), kableExtra(v.1.4.0), readxl(v.1.4.5), phytools(v.2.4-4), maps(v.3.4.3), ape(v.5.8-1) and knitr(v.1.50)
loaded via a namespace (and not attached): svUnit(v.1.0.6), ggplotify(v.0.1.2), cellranger(v.1.1.0), lifecycle(v.1.0.4), rstatix(v.0.7.2), doParallel(v.1.0.17), globals(v.0.17.0), processx(v.3.8.6), lattice(v.0.22-7), MASS(v.7.3-60), insight(v.1.3.1), crosstalk(v.1.2.1), ggdist(v.3.3.3), backports(v.1.5.0), magrittr(v.2.0.3), sass(v.0.4.10), rmarkdown(v.2.29), jquerylib(v.0.1.4), yaml(v.2.3.10), pkgbuild(v.1.4.8), abind(v.1.4-8), expm(v.1.0-0), quadprog(v.1.5-8), yulab.utils(v.0.2.0), tensorA(v.0.36.2.1), inline(v.0.3.21), listenv(v.0.9.1), tidytree(v.0.4.6), bridgesampling(v.1.1-2), parallelly(v.1.45.0), svglite(v.2.2.1), codetools(v.0.2-20), xml2(v.1.3.8), tidyselect(v.1.2.1), aplot(v.0.2.5), farver(v.2.1.2), matrixStats(v.1.5.0), stats4(v.4.3.2), jsonlite(v.2.0.0), Formula(v.1.2-5), iterators(v.1.0.14), emmeans(v.1.11.1), systemfonts(v.1.2.3), foreach(v.1.5.2), tools(v.4.3.2), treeio(v.1.26.0), ragg(v.1.4.0), glue(v.1.8.0), mnormt(v.2.1.1), gridExtra(v.2.3), xfun(v.0.52), distributional(v.0.5.0), withr(v.3.0.2), numDeriv(v.2016.8-1.1), combinat(v.0.0-8), fastmap(v.1.2.0), callr(v.3.7.6), digest(v.0.6.37), timechange(v.0.3.0), R6(v.2.6.1), gridGraphics(v.0.5-1), estimability(v.1.5.1), colorspace(v.2.1-1), textshaping(v.1.0.1), utf8(v.1.2.5), generics(v.0.1.4), data.table(v.1.17.4), clusterGeneration(v.1.3.8), httr(v.1.4.7), htmlwidgets(v.1.6.4), scatterplot3d(v.0.3-44), pkgconfig(v.2.0.3), gtable(v.0.3.6), htmltools(v.0.5.8.1), carData(v.3.0-5), scales(v.1.4.0), png(v.0.1-8), ggfun(v.0.1.8), rstudioapi(v.0.17.1), reshape2(v.1.4.4), tzdb(v.0.5.0), curl(v.6.2.3), coda(v.0.19-4.1), checkmate(v.2.3.2), nlme(v.3.1-168), cachem(v.1.1.0), DEoptim(v.2.2-8), parallel(v.4.3.2), desc(v.1.4.3), pillar(v.1.10.2), grid(v.4.3.2), vctrs(v.0.6.5), car(v.3.1-3), arrayhelpers(v.1.1-0), xtable(v.1.8-4), evaluate(v.1.0.4), mvtnorm(v.1.3-3), cli(v.3.6.5), compiler(v.4.3.2), rlang(v.1.1.6), rstantools(v.2.4.0), ggsignif(v.0.6.4), labeling(v.0.4.3), ps(v.1.9.1), plyr(v.1.8.9), fs(v.1.6.6), pander(v.0.6.6), stringi(v.1.8.7), QuickJSR(v.1.7.0), lazyeval(v.0.2.2), optimParallel(v.1.0-2), V8(v.6.0.4), Brobdingnag(v.1.2-9), Matrix(v.1.6-1.1), hms(v.1.1.3), clipr(v.0.8.0), igraph(v.2.1.4), RcppParallel(v.5.1.10), bslib(v.0.9.0), phangorn(v.2.12.1) and fastmatch(v.1.1-6)